[m-rev.] for review: improve I/O implementation for erlang backend

[Peter Ross]

On Thu, Jun 21, 2007 at 05:45:52PM +1000, Peter Wang wrote:
> Estimated hours taken: 6
> Branches: main
> 
> Improve the Erlang I/O implementation.
> 
> library/io.m:
> 	In the Erlang implementation, implement:
> 
> 	- support for pushback and line number tracking in I/O streams
> 	- seeking on binary streams
> 	- io.write_byte, io.write_bytes
> 	- io.make_temp
> 	- io.get_exit_status, io.set_exit_status
> 
> 	Export some functions written in foreign_procs, otherwise they couldn't
> 	be called if foreign_procs got inlined into other modules.
> 
> 	Fix some places in which we didn't convert Erlang error return values
> 	to strings.
> 
> library/erlang_builtin.m:
> 	Make the Erlang global server track the current exit status.
> 
> compiler/elds_to_erlang.m:
> 	Make the Erlang main wrapper, return the last set exit status to the
> 	operating system.
> 
> tests/hard_coded/Mmakefile:
> tests/hard_coded/seek_test.exp:
> tests/hard_coded/seek_test.m:
> 	Add simple test case for io.seek_binary_input.
> 
> tests/hard_coded/remove_file.exp2:
> 	Add expected output for Erlang backend.
> 
> tests/general/structure_reuse/Mmakefile:
> 	Don't test this directory in Erlang grades.
> 
> 
> Index: compiler/elds_to_erlang.m
> ===================================================================
> RCS file: /home/mercury/mercury1/repository/mercury/compiler/elds_to_erlang.m,v
> retrieving revision 1.20
> diff -u -r1.20 elds_to_erlang.m
> --- compiler/elds_to_erlang.m	19 Jun 2007 01:10:52 -0000	1.20
> +++ compiler/elds_to_erlang.m	21 Jun 2007 07:24:43 -0000
> @@ -289,20 +289,34 @@
>                  StackTrace = erlang:get_stacktrace(),
>                  mercury__exception:'ML_report_uncaught_exception'(Excp),
>                  mercury__maybe_dump_stacktrace(StackTrace),
> -                mercury__shutdown(),
> -                % init:stop is preferred to calling halt but there seems
> -                % to be no way to choose the exit code otherwise.
> -                halt(1)
> +                mercury__shutdown(true)
>          end,
> -        mercury__shutdown().
> +        mercury__shutdown(false).
>  
>      mercury__startup() ->
>          mercury__erlang_builtin:'ML_start_global_server'(),
>          mercury__io:'ML_io_init_state'().
>  
> -    mercury__shutdown() ->
> +    mercury__shutdown(ForceBadExit) ->
>          mercury__io:'ML_io_finalize_state'(),
> -        mercury__erlang_builtin:'ML_stop_global_server'().
> +        'ML_erlang_global_server' ! {get_exit_status, self()},
> +        receive
> +            {get_exit_status_ack, ExitStatus0} ->
> +                void
> +        end,
> +        if
> +            ExitStatus0 =:= 0 andalso ForceBadExit ->
> +                ExitStatus = 1;
> +            true ->
> +                ExitStatus = ExitStatus0
> +        end,
> +        mercury__erlang_builtin:'ML_stop_global_server'(),
> +        % init:stop is preferred to calling halt but there seems
> +        % to be no way to choose the exit code otherwise.
> +        case ExitStatus of
> +            0 -> void;
> +            _ -> halt(ExitStatus)
> +        end.
>  
>      mercury__maybe_dump_stacktrace(StackTrace) ->
>          case os:getenv(""MERCURY_SUPPRESS_STACK_TRACE"") of
> Index: library/erlang_builtin.m
> ===================================================================
> RCS file: /home/mercury/mercury1/repository/mercury/library/erlang_builtin.m,v
> retrieving revision 1.2
> diff -u -r1.2 erlang_builtin.m
> --- library/erlang_builtin.m	14 Jun 2007 01:50:29 -0000	1.2
> +++ library/erlang_builtin.m	21 Jun 2007 07:24:44 -0000
> @@ -45,6 +45,7 @@
>      [will_not_call_mercury, promise_pure, thread_safe],
>  "
>      Pid = spawn(fun global_server_loop/0),
> +    Pid ! {set_exit_status, 0},
>      register('ML_erlang_global_server', Pid)
>  ").
>  
> @@ -101,6 +102,24 @@
>              From ! {trace_evaluate_runtime_condition_ack, Ret},
>              global_server_loop();
>  
> +        {init_std_streams, Streams} ->
> +            put('ML_std_streams', Streams),
> +            global_server_loop();
> +
> +        {get_std_streams, From} ->
> +            Streams = get('ML_std_streams'),
> +            From ! {get_std_streams_ack, Streams},
> +            global_server_loop();
> +
> +        {get_exit_status, From} ->
> +            ExitStatus = get('ML_exit_status'),
> +            From ! {get_exit_status_ack, ExitStatus},
> +            global_server_loop();
> +
> +        {set_exit_status, ExitStatus} ->
> +            put('ML_exit_status', ExitStatus),
> +            global_server_loop();
> +
>          {stop, From} ->
>              From ! {stop_ack};
>  
> Index: library/io.m
> ===================================================================
> RCS file: /home/mercury/mercury1/repository/mercury/library/io.m,v
> retrieving revision 1.392
> diff -u -r1.392 io.m
> --- library/io.m	7 Jun 2007 07:23:45 -0000	1.392
> +++ library/io.m	21 Jun 2007 07:24:44 -0000
> @@ -5074,6 +5092,41 @@
>      io.set_globals(Globals, !IO),
>      io.insert_std_stream_names(!IO).
>  
> +:- pred init_std_streams(io::di, io::uo) is det.
> +
> +init_std_streams(!IO).
> +
> +:- pragma foreign_proc("Erlang",
> +    init_std_streams(_IO0::di, _IO::uo),
> +    [will_not_call_mercury, promise_pure],
> +"
> +    F = (fun() -> mercury_file_server(group_leader(), 1, []) end),
> +    StdinPid = spawn(F),
> +    StdoutPid = spawn(F),
> +    StderrPid = spawn(F),
> +    StdinBinaryPid = spawn(F),
> +    StdoutBinaryPid = spawn(F),
> +
> +    Stdin = {'ML_stream', make_ref(), StdinPid},
> +    Stdout = {'ML_stream', make_ref(), StdoutPid},
> +    Stderr = {'ML_stream', make_ref(), StderrPid},
> +    StdinBinary = {'ML_stream', make_ref(), StdinBinaryPid},
> +    StdoutBinary = {'ML_stream', make_ref(), StdoutBinaryPid},
> +
> +    % Initialise the process dictionary.
> +    put('ML_stdin_stream', Stdin),
> +    put('ML_stdout_stream', Stdout),
> +    put('ML_stderr_stream', Stderr),
> +    put('ML_stdin_binary_stream', StdinBinary),
> +    put('ML_stdout_binary_stream', StdoutBinary),
> +
> +    % Save the standard streams to the global server. When we spawn a new
> +    % Mercury thread later we will need to look it up in order to initialise
> +    % the new process's process dictionary.
> +    StdStreams = {Stdin, Stdout, Stderr, StdinBinary, StdoutBinaryPid},
> +    'ML_erlang_global_server' ! {init_std_streams, StdStreams}
> +").
> +
>  :- pred io.finalize_state(io::di, io::uo) is det.
>  
>      % For use by the Mercury runtime.
> @@ -6057,13 +6110,248 @@

>  :- pragma foreign_code("Erlang", "
>  
> -mercury_standard_io_stream(Id) ->
> -    % See stdlib io.erl.  We don't use the atom standard_io as it only
> -    % works with io: functions and not file: functions.
> -    IoDevice = group_leader(),
> -    {'ML_stream', Id, IoDevice}.
> +    % For each open file we have a process running in the background.
> +    % This is necessary so we can layer pushback support and line number
> +    % tracking on top of what the Erlang runtime provides.
> +    %
> +mercury_file_server(IoDevice, LineNr0, PutBack0) ->
> +    receive
> +        {From, close} ->
> +            From ! {self(), close_ack},
> +            file:close(IoDevice)
> +            % XXX check error?
> +    ;
> +        {From, read_char} ->
> +            case PutBack0 of
> +                [] ->
> +                    case file:read(IoDevice, 1) of
> +                        {ok, [Char]} ->
> +                            Ret = Char,
> +                            LineNr = LineNr0 + one_if_nl(Char);
> +                        EofOrError ->
> +                            Ret = EofOrError,
> +                            LineNr = LineNr0
> +                    end,
> +                    PutBack = PutBack0;
> +                [Char | PutBack] ->
> +                    Ret = Char,
> +                    LineNr = LineNr0 + one_if_nl(Char)
> +            end,
> +            From ! {self(), read_char_ack, Ret},
> +            mercury_file_server(IoDevice, LineNr, PutBack)
> +    ;
> +        {From, putback, Char} ->
> +            From ! {self(), putback_ack},
> +            PutBack = [Char | PutBack0],
> +            LineNr = LineNr0 - one_if_nl(Char),
> +            mercury_file_server(IoDevice, LineNr, PutBack)
> +    ;
> +        {From, write_char, Char} ->
> +            From ! {self(), write_char_ack},
> +            % XXX use file:write with raw streams
> +
> +            io:put_chars(IoDevice, [Char]),
> +            LineNr = LineNr0 + one_if_nl(Char),
> +            mercury_file_server(IoDevice, LineNr, PutBack0)

I don't understand how this code handles the write failing (eg file
system full)

I believe we should throw an exception in that case.

> +    ;
> +        {From, write_string, Chars} ->
> +            From ! {self(), write_string_ack},
> +            % XXX use file:write with raw streams
> +            io:put_chars(IoDevice, Chars),
> +            LineNr = LineNr0 + count_nls(Chars, 0),
> +            mercury_file_server(IoDevice, LineNr, PutBack0)
> +    ;
> +        {From, write_int, Val} ->
> +            From ! {self(), write_int_ack},
> +            % XXX use file:write with raw streams
> +            io:format(IoDevice, ""~B"", [Val]),
> +            mercury_file_server(IoDevice, LineNr0, PutBack0)
> +    ;
> +        {From, sync} ->
> +            % XXX file:sync seems to hang if run on a pid, e.g. standard I/O
> +            if
> +                is_pid(IoDevice) ->
> +                    void;
> +                true ->
> +                    file:sync(IoDevice)
> +            end,
> +            From ! {self(), sync_ack},
> +            mercury_file_server(IoDevice, LineNr0, PutBack0)
> +    ;
> +        {From, get_line_number} ->
> +            From ! {self(), get_line_number_ack, LineNr0},
> +            mercury_file_server(IoDevice, LineNr0, PutBack0)
> +    ;
> +        {From, set_line_number, N} ->
> +            From ! {self(), set_line_number_ack},
> +            mercury_file_server(IoDevice, N, PutBack0)
> +    ;
> +        {From, seek, Loc} ->
> +            SeekResult = file:position(IoDevice, Loc),
> +            From ! {self(), seek_ack, SeekResult},
> +            mercury_file_server(IoDevice, LineNr0, PutBack0)
> +    ;
> +        Other ->
> +            io:format(""** io.m: unrecognised message ~p~n"", [Other]),
> +            mercury_file_server(IoDevice, LineNr0, PutBack0)
> +    end.
> +

> +mercury_getc(Stream) ->
> +    {'ML_stream', _Id, Pid} = Stream,
> +    Pid ! {self(), read_char},
> +    receive
> +        {Pid, read_char_ack, Ret} ->
> +            case Ret of
> +                C when is_integer(C) ->
> +                    C;
> +                eof ->
> +                    -1;
> +                {error, Reason} ->
> +                    put('MR_io_exception', Reason),
> +                    -2
> +            end
> +    end.
> +
> +mercury_putback(Stream, Character) ->
> +    {'ML_stream', _Id, Pid} = Stream,
> +    Pid ! {self(), putback, Character},
> +    receive
> +        {Pid, putback_ack} ->
> +            void
> +    end.
> +
Add an explaination of why you do the ack,
and you don't actually return any data.

> +mercury_write_string(Stream, Characters) ->
> +    {'ML_stream', _Id, Pid} = Stream,
> +    Pid ! {self(), write_string, Characters},
> +    receive
> +        {Pid, write_string_ack} ->
> +            void
> +    end.
> +
> +mercury_write_char(Stream, Character) ->
> +    {'ML_stream', _Id, Pid} = Stream,
> +    Pid ! {self(), write_char, Character},
> +    receive
> +        {Pid, write_char_ack} ->
> +            void
> +    end.
> +
> +mercury_write_int(Stream, Value) ->
> +    {'ML_stream', _Id, Pid} = Stream,
> +    Pid ! {self(), write_int, Value},
> +    receive
> +        {Pid, write_int_ack} ->
> +            void
> +    end.
> +
> +mercury_sync(Stream) ->
> +    {'ML_stream', _Id, Pid} = Stream,
> +    Pid ! {self(), sync},
> +    receive
> +        {Pid, sync_ack} ->
> +            void
> +    end.
> +
> +mercury_get_line_number(Stream) ->
> +    {'ML_stream', _Id, Pid} = Stream,
> +    Pid ! {self(), get_line_number},
> +    receive
> +        {Pid, get_line_number_ack, LineNum} ->
> +            LineNum
> +    end.
> +
> +mercury_set_line_number(Stream, LineNum) ->
> +    {'ML_stream', _Id, Pid} = Stream,
> +    Pid ! {self(), set_line_number, LineNum},
> +    receive
> +        {Pid, set_line_number_ack} ->
> +            void
> +    end.
> +
> +mercury_seek(Stream, Loc) ->
> +    {'ML_stream', _Id, Pid} = Stream,
> +    Pid ! {self(), seek, Loc},
> +    receive
> +        {Pid, seek_ack, Result} ->
> +            case Result of
> +                {ok, NewPosition} ->
> +                    NewPosition;
> +                {error, Reason} ->
> +                    put('MR_io_exception', Reason),
> +                    -1
> +            end
> +    end.
>  
>  mercury_current_text_input() ->
>      get('ML_io_current_text_input').

Otherwise it looks fine.
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------