Skip to content

Commit 9d6974f

Browse files
committed
kernel: bypass unicode translation in group for latin1 putc_requests
latin1 requests are sent to user_drv, if its in latin1 mode, and raw output mode, then just output the latin1 binary. Otherwise user_drv will convert the output to unicode.
1 parent 14e885a commit 9d6974f

File tree

5 files changed

+74
-36
lines changed

5 files changed

+74
-36
lines changed

lib/kernel/src/group.erl

Lines changed: 6 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -608,36 +608,16 @@ putc_request({put_chars,unicode,M,F,As}, Drv, From) ->
608608
{reply,{error,F}}
609609
end
610610
end;
611-
putc_request({put_chars,latin1,Binary}, Drv, From) when is_binary(Binary) ->
612-
send_drv(Drv, {put_chars_sync, unicode,
613-
unicode:characters_to_binary(Binary,latin1),
614-
From}),
611+
putc_request({put_chars,latin1,Output}, Drv, From) ->
612+
send_drv(Drv, {put_chars_sync, latin1, Output, From}),
615613
noreply;
616-
putc_request({put_chars,latin1,Chars}, Drv, From) ->
617-
case catch unicode:characters_to_binary(Chars,latin1) of
618-
Binary when is_binary(Binary) ->
619-
send_drv(Drv, {put_chars_sync, unicode, Binary, From}),
620-
noreply;
621-
_ ->
622-
{reply,{error,{put_chars,latin1,Chars}}}
623-
end;
624614
putc_request({put_chars,latin1,M,F,As}, Drv, From) ->
625615
case catch apply(M, F, As) of
626-
Binary when is_binary(Binary) ->
627-
send_drv(Drv, {put_chars_sync, unicode,
628-
unicode:characters_to_binary(Binary,latin1),
629-
From}),
630-
noreply;
631-
Chars ->
632-
case catch unicode:characters_to_binary(Chars,latin1) of
633-
B when is_binary(B) ->
634-
send_drv(Drv, {put_chars_sync, unicode, B, From}),
635-
noreply;
636-
_ ->
637-
{reply,{error,F}}
638-
end
616+
Ret when is_list(Ret) =:= false, is_binary(Ret) =:= false ->
617+
{reply, {error, F}};
618+
Chars -> send_drv(Drv, {put_chars_sync, latin1, Chars, From}),
619+
noreply
639620
end;
640-
641621
putc_request({requests,Reqs}, Drv, From) ->
642622
putc_requests(Reqs, {reply, ok}, Drv, From);
643623

lib/kernel/src/prim_tty.erl

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -111,7 +111,7 @@
111111
npwcwidth/1, npwcwidth/2,
112112
ansi_regexp/0, ansi_color/2]).
113113
-export([reader_stop/1, disable_reader/1, enable_reader/1, read/1, read/2,
114-
is_reader/2, is_writer/2]).
114+
is_reader/2, is_writer/2, output_mode/1]).
115115

116116
-nifs([isatty/1, tty_create/0, tty_init/2, setlocale/1,
117117
tty_select/2, tty_window_size/1,
@@ -476,6 +476,11 @@ is_writer(#state{ writer = {WriterPid, _} }, WriterPid) ->
476476
is_writer(_, _) ->
477477
false.
478478

479+
-spec output_mode(state()) -> cooked | raw.
480+
output_mode(State) ->
481+
#{output := Output} = State#state.options,
482+
Output.
483+
479484
-spec unicode(state()) -> boolean().
480485
unicode(State) ->
481486
State#state.unicode.

lib/kernel/src/user_drv.erl

Lines changed: 31 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -52,6 +52,9 @@
5252
%% Same as put_chars/3, but sends Reply to From when the characters are
5353
%% guaranteed to have been written to the terminal
5454
{put_chars_sync, unicode, binary(), {From :: pid(), Reply :: term()}} |
55+
%% Output raw binary, should only be called if output mode is set to raw
56+
%% and encoding set to latin1.
57+
{put_chars_sync, latin1, binary(), {From :: pid(), Reply :: term()}} |
5558
%% Put text in expansion area
5659
{put_expand, unicode, binary(), integer()} |
5760
{move_expand, -32768..32767} |
@@ -852,7 +855,7 @@ group_opts() ->
852855
[{expand_below, application:get_env(stdlib, shell_expand_location, below) =:= below}].
853856

854857
-spec io_request(request(), prim_tty:state()) -> {noreply, prim_tty:state()} |
855-
{term(), reference(), prim_tty:state()}.
858+
{term(), reference(), prim_tty:state()} | {term(), {error, term()}}.
856859
io_request({requests,Rs}, TTY) ->
857860
{noreply, io_requests(Rs, TTY)};
858861
io_request(redraw_prompt, TTY) ->
@@ -867,6 +870,22 @@ io_request(delete_line, TTY) ->
867870
write(prim_tty:handle_request(TTY, delete_line));
868871
io_request({put_chars, unicode, Chars}, TTY) ->
869872
write(prim_tty:handle_request(TTY, {putc, unicode:characters_to_binary(Chars)}));
873+
io_request({put_chars_sync, latin1, Chars, Reply}, TTY) ->
874+
try
875+
case {prim_tty:unicode(TTY), prim_tty:output_mode(TTY)} of
876+
{false, raw} ->
877+
Bin = if is_binary(Chars) -> Chars;
878+
true -> list_to_binary(Chars)
879+
end,
880+
{Output, NewTTY} = prim_tty:handle_request(TTY, {putc_raw, Bin}),
881+
{ok, MonitorRef} = prim_tty:write(NewTTY, Output, self()),
882+
{Reply, MonitorRef, NewTTY};
883+
_ ->
884+
io_request({put_chars_sync, unicode, unicode:characters_to_binary(Chars,latin1), Reply}, TTY)
885+
end
886+
catch
887+
_:_ -> {Reply, {error, {put_chars, latin1, Chars}}}
888+
end;
870889
io_request({put_chars_sync, unicode, Chars, Reply}, TTY) ->
871890
{Output, NewTTY} = prim_tty:handle_request(TTY, {putc, unicode:characters_to_binary(Chars)}),
872891
{ok, MonitorRef} = prim_tty:write(NewTTY, Output, self()),
@@ -958,23 +977,29 @@ mktemp() ->
958977
handle_req(next, TTYState, {false, IOQ} = IOQueue) ->
959978
case queue:out(IOQ) of
960979
{empty, _} ->
961-
{TTYState, IOQueue};
980+
{TTYState, IOQueue};
962981
{{value, {Origin, Req}}, ExecQ} ->
963982
case io_request(Req, TTYState) of
964983
{noreply, NewTTYState} ->
965-
handle_req(next, NewTTYState, {false, ExecQ});
984+
handle_req(next, NewTTYState, {false, ExecQ});
966985
{Reply, MonitorRef, NewTTYState} ->
967-
{NewTTYState, {{Origin, MonitorRef, Reply}, ExecQ}}
986+
{NewTTYState, {{Origin, MonitorRef, Reply}, ExecQ}};
987+
{Reply, {error, Reason}} ->
988+
Origin ! {reply, Reply, {error, Reason}},
989+
handle_req(next, TTYState, {false, ExecQ})
968990
end
969991
end;
970992
handle_req(Msg, TTYState, {false, IOQ} = IOQueue) ->
971993
empty = queue:peek(IOQ),
972994
{Origin, Req} = Msg,
973995
case io_request(Req, TTYState) of
974996
{noreply, NewTTYState} ->
975-
{NewTTYState, IOQueue};
997+
{NewTTYState, IOQueue};
976998
{Reply, MonitorRef, NewTTYState} ->
977-
{NewTTYState, {{Origin, MonitorRef, Reply}, IOQ}}
999+
{NewTTYState, {{Origin, MonitorRef, Reply}, IOQ}};
1000+
{Reply, {error, Reason}} ->
1001+
Origin ! {reply, Reply, {error, Reason}},
1002+
{TTYState, IOQueue}
9781003
end;
9791004
handle_req(Msg,TTYState,{Resp, IOQ}) ->
9801005
%% All requests are queued when we have outstanding sync put_chars

lib/stdlib/test/escript_SUITE.erl

Lines changed: 24 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -39,7 +39,8 @@
3939
overflow/1,
4040
verify_sections/4,
4141
unicode/1,
42-
bad_io_server/1
42+
bad_io_server/1,
43+
bypass_unicode_conversion/1
4344
]).
4445

4546
-include_lib("common_test/include/ct.hrl").
@@ -54,9 +55,10 @@ all() ->
5455
emulator_flags_no_shebang, two_lines,
5556
module_script, beam_script, archive_script, epp,
5657
create_and_extract, foldl, overflow,
57-
archive_script_file_access, unicode, bad_io_server].
58+
archive_script_file_access, unicode, bad_io_server,
59+
bypass_unicode_conversion].
5860

59-
groups() ->
61+
groups() ->
6062
[].
6163

6264
init_per_suite(Config) ->
@@ -978,6 +980,25 @@ bad_io_server(Config) when is_list(Config) ->
978980
"called as '\\x{400}' / 0\nExitCode:127">>]),
979981
ok.
980982

983+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
984+
985+
bypass_unicode_conversion(Config) when is_list(Config) ->
986+
Data = proplists:get_value(data_dir, Config),
987+
Dir = filename:absname(Data), %Get rid of trailing slash.
988+
Cmd = fun(Enc) -> "bypass_unicode_conversion "++atom_to_list(Enc)++" 1> /dev/null" end,
989+
{TimeLatin1, _} = timer:tc(
990+
fun() -> run(Config, Dir, Cmd(latin1), [<<"ExitCode:0">>]) end),
991+
{TimeUnicode, _} = timer:tc(
992+
fun() -> run(Config, Dir, Cmd(unicode), [<<"ExitCode:0">>]) end),
993+
%% Check that Time(latin1) is about the same as Time(unicode)
994+
%% Without the bypass, the time difference would be about 5x.
995+
%% Turns out that the timing might be a bit unstable, so we allow a 2x difference.
996+
io:format("Time(latin1) = ~p ~~= Time(unicode) = ~p~n", [TimeLatin1, TimeUnicode]),
997+
true = TimeLatin1 =< TimeUnicode * 2,
998+
ok.
999+
1000+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1001+
9811002
run(Config, Dir, Cmd, Expected) ->
9821003
run_with_opts(Config, Dir, "", Cmd, Expected).
9831004

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
#!/usr/bin/env escript
2+
3+
main([Enc]) ->
4+
Data = {tuple, {list, lists:seq(1,1000000)}},
5+
io:setopts(group_leader(), [{encoding, list_to_atom(Enc)}]),
6+
file:write(group_leader(), term_to_binary(Data)),
7+
ok.

0 commit comments

Comments
 (0)