1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1996-2019. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20-module(io).
21
22-export([put_chars/1,put_chars/2,nl/0,nl/1,
23	 get_chars/2,get_chars/3,get_line/1,get_line/2,
24	 get_password/0, get_password/1,
25	 setopts/1, setopts/2, getopts/0, getopts/1]).
26-export([write/1,write/2,read/1,read/2,read/3,read/4]).
27-export([columns/0,columns/1,rows/0,rows/1]).
28-export([fwrite/1,fwrite/2,fwrite/3,fread/2,fread/3,
29	 format/1,format/2,format/3]).
30-export([scan_erl_exprs/1,scan_erl_exprs/2,scan_erl_exprs/3,scan_erl_exprs/4,
31	 scan_erl_form/1,scan_erl_form/2,scan_erl_form/3,scan_erl_form/4,
32	 parse_erl_exprs/1,parse_erl_exprs/2,parse_erl_exprs/3,
33         parse_erl_exprs/4,parse_erl_form/1,parse_erl_form/2,
34         parse_erl_form/3,parse_erl_form/4]).
35-export([request/1,request/2,requests/1,requests/2]).
36%% Implemented in native code
37-export([printable_range/0]).
38
39-export_type([device/0, format/0, server_no_data/0]).
40
41%%-------------------------------------------------------------------------
42
43-type device() :: atom() | pid().
44-type prompt() :: atom() | unicode:chardata().
45
46%% ErrorDescription is whatever the I/O-server sends.
47-type server_no_data() :: {'error', ErrorDescription :: term()} | 'eof'.
48
49-type location() :: erl_anno:location().
50
51%%-------------------------------------------------------------------------
52%% Needs to be inlined for error_info to be correct
53-compile({inline,[o_request/2]}).
54o_request(Function, OrigArgs) ->
55    {Io, Request} =
56        if
57            Function =:= format; Function =:= fwrite ->
58                case OrigArgs of
59                    [Format] ->
60                        {default_output(), {format, Format, []}};
61                    [Format, Args] ->
62                        {default_output(), {format, Format, Args}};
63                    [D, Format, Args] ->
64                        {D, {format, Format, Args}}
65                end;
66            Function =:= put_chars ->
67                case OrigArgs of
68                    [Chars] ->
69                        {default_output(), {put_chars, unicode, Chars}};
70                    [D, Chars] ->
71                        {D, {put_chars, unicode, Chars}};
72                    [D, Encoding, Chars] ->
73                        {D, {put_chars, Encoding, Chars}}
74                end;
75            Function =:= nl ->
76                case OrigArgs of
77                    [] ->
78                        {default_output(), nl};
79                    [D] ->
80                        {D, nl}
81                end;
82            Function =:= write ->
83                case OrigArgs of
84                    [Term] ->
85                        {default_output(), {write, Term}};
86                    [D, Term] ->
87                        {D, {write, Term}}
88                end
89        end,
90    ErrorRef = make_ref(),
91    case request(Io, Request, ErrorRef) of
92        {ErrorRef, Reason} ->
93            %% We differentiate between errors that are created by this module
94            erlang:error(conv_reason(Reason), OrigArgs,
95                         [{error_info,#{cause => {?MODULE, Reason},
96                                        module => erl_stdlib_errors}}]);
97        {error, Reason} ->
98            %% and the errors we get from the Device
99            erlang:error(conv_reason(Reason), OrigArgs,
100                         [{error_info,#{cause => {device, Reason},
101                                        module => erl_stdlib_errors}}]);
102        Other ->
103            Other
104    end.
105
106%%
107%% User interface.
108%%
109
110%% Request what the user considers printable characters
111-spec printable_range() -> 'unicode' | 'latin1'.
112printable_range() ->
113    erlang:nif_error(undefined).
114
115%% Put chars takes mixed *unicode* list from R13 onwards.
116-spec put_chars(CharData) -> 'ok' when
117      CharData :: unicode:chardata().
118
119put_chars(Chars) ->
120    o_request(?FUNCTION_NAME, [Chars]).
121
122-spec put_chars(IoDevice, CharData) -> 'ok' when
123      IoDevice :: device(),
124      CharData :: unicode:chardata().
125
126put_chars(Io, Chars) ->
127    o_request(?FUNCTION_NAME, [Io, Chars]).
128
129-spec nl() -> 'ok'.
130
131nl() ->
132    o_request(?FUNCTION_NAME, []).
133
134-spec nl(IoDevice) -> 'ok' when
135      IoDevice :: device().
136
137nl(Io) ->
138    o_request(?FUNCTION_NAME, [Io]).
139
140-spec columns() -> {'ok', pos_integer()} | {'error', 'enotsup'}.
141
142columns() ->
143    columns(default_output()).
144
145-spec columns(IoDevice) -> {'ok', pos_integer()} | {'error', 'enotsup'} when
146      IoDevice :: device().
147
148columns(Io) ->
149    case request(Io, {get_geometry,columns}) of
150	N  when is_integer(N), N > 0 ->
151	    {ok,N};
152	_ ->
153	    {error,enotsup}
154    end.
155
156-spec rows() -> {'ok', pos_integer()} | {'error', 'enotsup'}.
157
158rows() ->
159    rows(default_output()).
160
161-spec rows(IoDevice) -> {'ok', pos_integer()} | {'error', 'enotsup'} when
162      IoDevice :: device().
163
164rows(Io) ->
165    case request(Io,{get_geometry,rows}) of
166	N  when is_integer(N), N > 0 ->
167	    {ok,N};
168	_ ->
169	    {error,enotsup}
170    end.
171
172-spec get_chars(Prompt, Count) -> Data | server_no_data() when
173      Prompt :: prompt(),
174      Count :: non_neg_integer(),
175      Data :: string() | unicode:unicode_binary().
176
177get_chars(Prompt, N) ->
178    get_chars(default_input(), Prompt, N).
179
180-spec get_chars(IoDevice, Prompt, Count) -> Data | server_no_data() when
181      IoDevice :: device(),
182      Prompt :: prompt(),
183      Count :: non_neg_integer(),
184      Data :: string() | unicode:unicode_binary().
185
186get_chars(Io, Prompt, N) when is_integer(N), N >= 0 ->
187    request(Io, {get_chars,unicode,Prompt,N}).
188
189-spec get_line(Prompt) -> Data | server_no_data() when
190      Prompt :: prompt(),
191      Data :: string() | unicode:unicode_binary().
192
193get_line(Prompt) ->
194    get_line(default_input(), Prompt).
195
196-spec get_line(IoDevice, Prompt) -> Data | server_no_data() when
197      IoDevice :: device(),
198      Prompt :: prompt(),
199      Data :: string() | unicode:unicode_binary().
200
201get_line(Io, Prompt) ->
202    request(Io, {get_line,unicode,Prompt}).
203
204get_password() ->
205    get_password(default_input()).
206
207get_password(Io) ->
208    request(Io, {get_password,unicode}).
209
210-type encoding()   :: 'latin1' | 'unicode' | 'utf8' | 'utf16' | 'utf32'
211                    | {'utf16', 'big' | 'little'} | {'utf32','big' | 'little'}.
212-type expand_fun() :: fun((term()) -> {'yes'|'no', string(), [string(), ...]}).
213-type opt_pair()   :: {'binary', boolean()}
214                    | {'echo', boolean()}
215                    | {'expand_fun', expand_fun()}
216                    | {'encoding', encoding()}.
217
218-spec getopts() -> [opt_pair()] | {'error', Reason} when
219      Reason :: term().
220
221getopts() ->
222    getopts(default_input()).
223
224-spec getopts(IoDevice) -> [opt_pair()] | {'error', Reason} when
225      IoDevice :: device(),
226      Reason :: term().
227
228getopts(Io) ->
229    request(Io, getopts).
230
231-type setopt() :: 'binary' | 'list' | opt_pair().
232
233-spec setopts(Opts) -> 'ok' | {'error', Reason} when
234      Opts :: [setopt()],
235      Reason :: term().
236
237setopts(Opts) ->
238    setopts(default_input(), Opts).
239
240-spec setopts(IoDevice, Opts) -> 'ok' | {'error', Reason} when
241      IoDevice :: device(),
242      Opts :: [setopt()],
243      Reason :: term().
244
245setopts(Io, Opts) ->
246    request(Io, {setopts, Opts}).
247
248%% Writing and reading Erlang terms.
249
250-spec write(Term) -> 'ok' when
251      Term :: term().
252
253write(Term) ->
254    o_request(?FUNCTION_NAME, [Term]).
255
256-spec write(IoDevice, Term) -> 'ok' when
257      IoDevice :: device(),
258      Term :: term().
259
260write(Io, Term) ->
261    o_request(?FUNCTION_NAME, [Io, Term]).
262
263
264-spec read(Prompt) -> Result when
265      Prompt :: prompt(),
266      Result :: {'ok', Term :: term()}
267              | server_no_data()
268              | {'error', ErrorInfo},
269      ErrorInfo :: erl_scan:error_info() | erl_parse:error_info().
270
271read(Prompt) ->
272    read(default_input(), Prompt).
273
274-spec read(IoDevice, Prompt) -> Result when
275      IoDevice :: device(),
276      Prompt :: prompt(),
277      Result :: {'ok', Term :: term()}
278              | server_no_data()
279              | {'error', ErrorInfo},
280      ErrorInfo :: erl_scan:error_info() | erl_parse:error_info().
281
282read(Io, Prompt) ->
283    case request(Io, {get_until,unicode,Prompt,erl_scan,tokens,[1]}) of
284	{ok,Toks,_EndLine} ->
285	    erl_parse:parse_term(Toks);
286	{error,E,_EndLine} ->
287	    {error,E};
288	{eof,_EndLine} ->
289	    eof;
290	Other ->
291	    Other
292    end.
293
294-spec read(IoDevice, Prompt, StartLocation) -> Result when
295      IoDevice :: device(),
296      Prompt :: prompt(),
297      StartLocation :: location(),
298      Result :: {'ok', Term :: term(), EndLocation :: location()}
299              | {'eof', EndLocation :: location()}
300              | server_no_data()
301              | {'error', ErrorInfo, ErrorLocation :: location()},
302      ErrorInfo :: erl_scan:error_info() | erl_parse:error_info().
303
304read(Io, Prompt, Pos0) ->
305    read(Io, Prompt, Pos0, []).
306
307-spec read(IoDevice, Prompt, StartLocation, Options) -> Result when
308      IoDevice :: device(),
309      Prompt :: prompt(),
310      StartLocation :: location(),
311      Options :: erl_scan:options(),
312      Result :: {'ok', Term :: term(), EndLocation :: location()}
313              | {'eof', EndLocation :: location()}
314              | server_no_data()
315              | {'error', ErrorInfo, ErrorLocation :: location()},
316      ErrorInfo :: erl_scan:error_info() | erl_parse:error_info().
317
318read(Io, Prompt, Pos0, Options) ->
319    Args = [Pos0,Options],
320    case request(Io, {get_until,unicode,Prompt,erl_scan,tokens,Args}) of
321	{ok,Toks,EndLocation} ->
322            case erl_parse:parse_term(Toks) of
323                {ok,Term} -> {ok,Term,EndLocation};
324                {error,ErrorInfo} -> {error,ErrorInfo,EndLocation}
325            end;
326	{error,_E,_EndLocation} = Error ->
327	    Error;
328	{eof,_EndLocation} = Eof ->
329	    Eof;
330	Other ->
331	    Other
332    end.
333
334%% Formatted writing and reading.
335
336conv_reason(arguments) -> badarg;
337conv_reason(terminated) -> terminated;
338conv_reason({no_translation,_,_}) -> no_translation;
339conv_reason(_Reason) -> badarg.
340
341-type format() :: atom() | string() | binary().
342
343-spec fwrite(Format) -> 'ok' when
344      Format :: format().
345
346fwrite(Format) ->
347    o_request(?FUNCTION_NAME, [Format]).
348
349-spec fwrite(Format, Data) -> 'ok' when
350      Format :: format(),
351      Data :: [term()].
352
353fwrite(Format, Args) ->
354    o_request(?FUNCTION_NAME, [Format, Args]).
355
356-spec fwrite(IoDevice, Format, Data) -> 'ok' when
357      IoDevice :: device(),
358      Format :: format(),
359      Data :: [term()].
360
361fwrite(Io, Format, Args) ->
362    o_request(?FUNCTION_NAME, [Io, Format, Args]).
363
364-spec fread(Prompt, Format) -> Result when
365      Prompt :: prompt(),
366      Format :: format(),
367      Result :: {'ok', Terms :: [term()]} | 'eof' | {'error', What :: term()}.
368
369fread(Prompt, Format) ->
370    fread(default_input(), Prompt, Format).
371
372-spec fread(IoDevice, Prompt, Format) -> Result when
373      IoDevice :: device(),
374      Prompt :: prompt(),
375      Format :: format(),
376      Result :: {'ok', Terms :: [term()]}
377              | {'error', {'fread', FreadError :: io_lib:fread_error()}}
378              | server_no_data().
379
380fread(Io, Prompt, Format) ->
381    request(Io, {fread,Prompt,Format}).
382
383-spec format(Format) -> 'ok' when
384      Format :: format().
385format(Format) ->
386    o_request(?FUNCTION_NAME, [Format]).
387
388-spec format(Format, Data) -> 'ok' when
389      Format :: format(),
390      Data :: [term()].
391
392format(Format, Args) ->
393    o_request(?FUNCTION_NAME, [Format, Args]).
394
395-spec format(IoDevice, Format, Data) -> 'ok' when
396      IoDevice :: device(),
397      Format :: format(),
398      Data :: [term()].
399
400format(Io, Format, Args) ->
401    o_request(?FUNCTION_NAME, [Io, Format, Args]).
402
403%% Scanning Erlang code.
404
405-spec scan_erl_exprs(Prompt) -> Result when
406      Prompt :: prompt(),
407      Result :: erl_scan:tokens_result() | server_no_data().
408
409scan_erl_exprs(Prompt) ->
410    scan_erl_exprs(default_input(), Prompt, 1).
411
412-spec scan_erl_exprs(Device, Prompt) -> Result when
413      Device :: device(),
414      Prompt :: prompt(),
415      Result :: erl_scan:tokens_result() | server_no_data().
416
417scan_erl_exprs(Io, Prompt) ->
418    scan_erl_exprs(Io, Prompt, 1).
419
420-spec scan_erl_exprs(Device, Prompt, StartLocation) -> Result when
421      Device :: device(),
422      Prompt :: prompt(),
423      StartLocation :: location(),
424      Result :: erl_scan:tokens_result() | server_no_data().
425
426scan_erl_exprs(Io, Prompt, Pos0) ->
427    scan_erl_exprs(Io, Prompt, Pos0, []).
428
429-spec scan_erl_exprs(Device, Prompt, StartLocation, Options) -> Result when
430      Device :: device(),
431      Prompt :: prompt(),
432      StartLocation :: location(),
433      Options :: erl_scan:options(),
434      Result :: erl_scan:tokens_result() | server_no_data().
435
436scan_erl_exprs(Io, Prompt, Pos0, Options) ->
437    request(Io, {get_until,unicode,Prompt,erl_scan,tokens,[Pos0,Options]}).
438
439-spec scan_erl_form(Prompt) -> Result when
440      Prompt :: prompt(),
441      Result :: erl_scan:tokens_result() | server_no_data().
442
443scan_erl_form(Prompt) ->
444    scan_erl_form(default_input(), Prompt, 1).
445
446-spec scan_erl_form(IoDevice, Prompt) -> Result when
447      IoDevice :: device(),
448      Prompt :: prompt(),
449      Result :: erl_scan:tokens_result() | server_no_data().
450
451scan_erl_form(Io, Prompt) ->
452    scan_erl_form(Io, Prompt, 1).
453
454-spec scan_erl_form(IoDevice, Prompt, StartLocation) -> Result when
455      IoDevice :: device(),
456      Prompt :: prompt(),
457      StartLocation :: location(),
458      Result :: erl_scan:tokens_result() | server_no_data().
459
460scan_erl_form(Io, Prompt, Pos0) ->
461    scan_erl_form(Io, Prompt, Pos0, []).
462
463-spec scan_erl_form(IoDevice, Prompt, StartLocation, Options) -> Result when
464      IoDevice :: device(),
465      Prompt :: prompt(),
466      StartLocation :: location(),
467      Options :: erl_scan:options(),
468      Result :: erl_scan:tokens_result() | server_no_data().
469
470scan_erl_form(Io, Prompt, Pos0, Options) ->
471    request(Io, {get_until,unicode,Prompt,erl_scan,tokens,[Pos0,Options]}).
472
473%% Parsing Erlang code.
474
475-type parse_ret() :: {'ok',
476                      ExprList :: [erl_parse:abstract_expr()],
477                      EndLocation :: location()}
478                   | {'eof', EndLocation :: location()}
479                   | {'error',
480                      ErrorInfo :: erl_scan:error_info()
481                                 | erl_parse:error_info(),
482                      ErrorLocation :: location()}
483                   | server_no_data().
484
485-spec parse_erl_exprs(Prompt) -> Result when
486      Prompt :: prompt(),
487      Result :: parse_ret().
488
489parse_erl_exprs(Prompt) ->
490    parse_erl_exprs(default_input(), Prompt, 1).
491
492-spec parse_erl_exprs(IoDevice, Prompt) -> Result when
493      IoDevice :: device(),
494      Prompt :: prompt(),
495      Result :: parse_ret().
496
497parse_erl_exprs(Io, Prompt) ->
498    parse_erl_exprs(Io, Prompt, 1).
499
500-spec parse_erl_exprs(IoDevice, Prompt, StartLocation) -> Result when
501      IoDevice :: device(),
502      Prompt :: prompt(),
503      StartLocation :: location(),
504      Result :: parse_ret().
505
506parse_erl_exprs(Io, Prompt, Pos0) ->
507    parse_erl_exprs(Io, Prompt, Pos0, []).
508
509-spec parse_erl_exprs(IoDevice, Prompt, StartLocation, Options) -> Result when
510      IoDevice :: device(),
511      Prompt :: prompt(),
512      StartLocation :: location(),
513      Options :: erl_scan:options(),
514      Result :: parse_ret().
515
516parse_erl_exprs(Io, Prompt, Pos0, Options) ->
517    case request(Io, {get_until,unicode,Prompt,erl_scan,tokens,[Pos0,Options]}) of
518	{ok,Toks,EndPos} ->
519	    case erl_parse:parse_exprs(Toks) of
520		{ok,Exprs} -> {ok,Exprs,EndPos};
521		{error,E} -> {error,E,EndPos}
522	    end;
523	Other ->
524	    Other
525    end.
526
527-type parse_form_ret() :: {'ok',
528                           AbsForm :: erl_parse:abstract_form(),
529                           EndLocation :: location()}
530                        | {'eof', EndLocation :: location()}
531                        | {'error',
532                           ErrorInfo :: erl_scan:error_info()
533                                      | erl_parse:error_info(),
534                           ErrorLocation :: location()}
535                        | server_no_data().
536
537-spec parse_erl_form(Prompt) -> Result when
538      Prompt :: prompt(),
539      Result :: parse_form_ret().
540
541parse_erl_form(Prompt) ->
542    parse_erl_form(default_input(), Prompt, 1).
543
544-spec parse_erl_form(IoDevice, Prompt) -> Result when
545      IoDevice :: device(),
546      Prompt :: prompt(),
547      Result :: parse_form_ret().
548
549parse_erl_form(Io, Prompt) ->
550    parse_erl_form(Io, Prompt, 1).
551
552-spec parse_erl_form(IoDevice, Prompt, StartLocation) -> Result when
553      IoDevice :: device(),
554      Prompt :: prompt(),
555      StartLocation :: location(),
556      Result :: parse_form_ret().
557
558parse_erl_form(Io, Prompt, Pos0) ->
559    parse_erl_form(Io, Prompt, Pos0, []).
560
561-spec parse_erl_form(IoDevice, Prompt, StartLocation, Options) -> Result when
562      IoDevice :: device(),
563      Prompt :: prompt(),
564      StartLocation :: location(),
565      Options :: erl_scan:options(),
566      Result :: parse_form_ret().
567
568parse_erl_form(Io, Prompt, Pos0, Options) ->
569    Args = [Pos0, Options],
570    case request(Io, {get_until,unicode,Prompt,erl_scan,tokens,Args}) of
571	{ok,Toks,EndPos} ->
572	    case erl_parse:parse_form(Toks) of
573		{ok,Exprs} -> {ok,Exprs,EndPos};
574		{error,E} -> {error,E,EndPos}
575	    end;
576	Other ->
577	    Other
578    end.
579
580%% Miscellaneous functions.
581
582request(Request) ->
583    request(default_output(), Request).
584
585request(Name, Request) ->
586    request(Name, Request, error).
587request(standard_io, Request, ErrorTag) ->
588    request(group_leader(), Request, ErrorTag);
589request(Pid, Request, ErrorTag) when is_pid(Pid) ->
590    execute_request(Pid, io_request(Pid, Request), ErrorTag);
591request(Name, Request, ErrorTag) when is_atom(Name) ->
592    case whereis(Name) of
593	undefined ->
594	    {ErrorTag, arguments};
595	Pid ->
596	    request(Pid, Request, ErrorTag)
597    end.
598
599execute_request(Pid, {Convert,Converted}, ErrorTag) ->
600    Mref = erlang:monitor(process, Pid),
601    Pid ! {io_request,self(),Mref,Converted},
602
603    receive
604	{io_reply, Mref, Reply} ->
605	    erlang:demonitor(Mref, [flush]),
606	    if
607		Convert ->
608		    convert_binaries(Reply);
609		true ->
610		    Reply
611	    end;
612	{'DOWN', Mref, _, _, _} ->
613	    receive
614		{'EXIT', Pid, _What} -> true
615	    after 0 -> true
616	    end,
617	    {ErrorTag,terminated}
618    end.
619
620requests(Requests) ->				%Requests as atomic action
621    requests(default_output(), Requests).
622
623requests(standard_io, Requests) ->              %Requests as atomic action
624    requests(group_leader(), Requests);
625requests(Pid, Requests) when is_pid(Pid) ->
626    {Convert, Converted} = io_requests(Pid, Requests),
627    execute_request(Pid,{Convert,{requests,Converted}},error);
628requests(Name, Requests) when is_atom(Name) ->
629    case whereis(Name) of
630	undefined ->
631	    {error, arguments};
632	Pid ->
633	    requests(Pid, Requests)
634    end.
635
636
637default_input() ->
638    group_leader().
639
640default_output() ->
641    group_leader().
642
643%% io_requests(Requests)
644%%  Transform requests into correct i/o server messages. Only handle the
645%%  one we KNOW must be changed, others, including incorrect ones, are
646%%  passed straight through. Perform a flatten on the request list.
647
648io_requests(Pid, Rs) ->
649    io_requests(Pid, Rs, [], []).
650
651io_requests(Pid, [{requests,Rs1}|Rs], Cont, Tail) ->
652    io_requests(Pid, Rs1, [Rs|Cont], Tail);
653io_requests(Pid, [R], [], _Tail) ->
654    {Conv,Request} = io_request(Pid, R),
655    {Conv,[Request]};
656io_requests(Pid, [R|Rs], Cont, Tail) ->
657    {_,Request} = io_request(Pid, R),
658    {Conv,Requests} = io_requests(Pid, Rs, Cont, Tail),
659    {Conv,[Request|Requests]};
660io_requests(Pid, [], [Rs|Cont], Tail) ->
661    io_requests(Pid, Rs, Cont, Tail);
662io_requests(_Pid, [], [], _Tail) ->
663    {false,[]}.
664
665bc_req(Pid, Req0, MaybeConvert) ->
666    case net_kernel:dflag_unicode_io(Pid) of
667	true ->
668	    %% The most common case. A modern i/o server.
669	    {false,Req0};
670	false ->
671	    %% Backward compatibility only. Unlikely to ever happen.
672	    case tuple_to_list(Req0) of
673		[Op,_Enc] ->
674		    {MaybeConvert,Op};
675		[Op,_Enc|T] ->
676		    Req = list_to_tuple([Op|T]),
677		    {MaybeConvert,Req}
678	    end
679    end.
680
681io_request(Pid, {write,Term}) ->
682    bc_req(Pid,{put_chars,unicode,io_lib,write,[Term]},false);
683io_request(Pid, {format,Format,Args}) ->
684    bc_req(Pid,{put_chars,unicode,io_lib,format,[Format,Args]},false);
685io_request(Pid, {fwrite,Format,Args}) ->
686    bc_req(Pid,{put_chars,unicode,io_lib,fwrite,[Format,Args]},false);
687io_request(Pid, nl) ->
688    bc_req(Pid,{put_chars,unicode,io_lib:nl()},false);
689io_request(Pid, {put_chars,Enc,Chars}=Request0)
690  when is_list(Chars), node(Pid) =:= node() ->
691    %% Convert to binary data if the I/O server is guaranteed to be new
692    Request =
693	case catch unicode:characters_to_binary(Chars,Enc) of
694	    Binary when is_binary(Binary) ->
695		{put_chars,Enc,Binary};
696	    _ ->
697		Request0
698	end,
699    {false,Request};
700io_request(Pid, {put_chars,Enc,Chars}=Request0)
701  when is_list(Chars) ->
702    case net_kernel:dflag_unicode_io(Pid) of
703	true ->
704	    case catch unicode:characters_to_binary(Chars,Enc,unicode) of
705		Binary when is_binary(Binary) ->
706		    {false,{put_chars,unicode,Binary}};
707		_ ->
708		    {false,Request0}
709	    end;
710	false ->
711	    %% Convert back to old style put_chars message...
712	    case catch unicode:characters_to_binary(Chars,Enc,latin1) of
713		Binary when is_binary(Binary) ->
714		    {false,{put_chars,Binary}};
715		_ ->
716		    {false,{put_chars,Chars}}
717	    end
718    end;
719io_request(Pid, {fread,Prompt,Format}) ->
720    bc_req(Pid,{get_until,unicode,Prompt,io_lib,fread,[Format]},true);
721io_request(Pid, {get_until,Enc,Prompt,M,F,A}) ->
722    bc_req(Pid,{get_until,Enc,Prompt,M,F,A},true);
723io_request(Pid, {get_chars,Enc,Prompt,N}) ->
724    bc_req(Pid,{get_chars,Enc,Prompt,N},true);
725io_request(Pid, {get_line,Enc,Prompt}) ->
726    bc_req(Pid,{get_line,Enc,Prompt},true);
727io_request(Pid, {get_password,Enc}) ->
728    bc_req(Pid,{get_password, Enc},true);
729io_request(_Pid, R) ->				%Pass this straight through
730    {false,R}.
731
732convert_binaries(Bin) when is_binary(Bin) ->
733    unicode:characters_to_binary(Bin,latin1,unicode);
734convert_binaries(Else) ->
735    Else.
736