% ----------------------------------------------------------------------
% BEGIN LICENSE BLOCK
% Version: CMPL 1.1
%
% The contents of this file are subject to the Cisco-style Mozilla Public
% License Version 1.1 (the "License"); you may not use this file except
% in compliance with the License.  You may obtain a copy of the License
% at www.eclipseclp.org/license.
% 
% 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. 
% 
% The Original Code is  The ECLiPSe Constraint Logic Programming System. 
% The Initial Developer of the Original Code is  Cisco Systems, Inc. 
% Portions created by the Initial Developer are
% Copyright (C) 1989-2006 Cisco Systems, Inc.  All Rights Reserved.
% 
% Contributor(s): ECRC GmbH
% Contributor(s): IC-Parc, Imperal College London
% Contributor(s): Coninfer Ltd
% 
% END LICENSE BLOCK
%
% System:	ECLiPSe Constraint Logic Programming System
% Component:	I/O-related builtins
%		Part of module(sepia_kernel)
% Description:	This was part of io.pl
% ----------------------------------------------------------------------

/*
 * GLOBAL DIRECTIVES
 */
:- pragma(nodebug).
:- pragma(expand).
:- pragma(skip).

:- export
	current_stream/3,
	get_stream_info/3,
	set_stream_property/3,
	current_stream/1,
	current_compiled_file/3,
	dump_header/1,
	dump_term/3,
	exec/2,
	exec/3,
	exec_group/3,
	make/0,
	open/4,
	sh/1,
	system/1,
	get_file_info/3,
	op/3,
	global_op/3.


:- tool(file_query/2, file_query_body/3).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% current_stream(?Stream)
% if Stream is uninstantiated, then stream handles returned.
% if used for testing, a stream name is accepted as well.

current_stream(Stream) :- var(Stream), !,
	open_streams(Streams),
	member(Stream, Streams).
current_stream(Stream) :- check_stream_spec(Stream), !,
	is_open_stream(Stream).
current_stream(Stream) :-
	bip_error(current_stream(Stream)).


% current_stream(?File, ?Mode, ?Stream) - DEPRECATED
current_stream(File, Mode, Stream) :-
	(
	    check_var_or_atom_string(File),
	    check_var_or_atom(Mode),
	    check_var_or_stream_spec(Stream)
	->
		( var(Stream) ->
		    open_streams(Streams),
		    member(Stream, Streams)
		;
		    is_open_stream(Stream)	% else fail
		),
		stream_info_(Stream, 0, File),
		stream_info_(Stream, 2, Mode)
	;
	    bip_error(current_stream(File, Mode, Stream))
	).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% get_stream_info(+Stream, ?Info, ?Value)
% t a s k : accesss various data in the stream descriptor

get_stream_info(Stream, Info, Value) :-
	( check_valid_stream(Stream) ->
	    (   var(Info) ->
		    stream_info_nr(Info, N),
		    stream_info_wrapper(Stream, N, Value)
	    ;   atom(Info) ->
		(   stream_info_nr(Info, N) ->
			stream_info_wrapper(Stream, N, Value)
		;   stream_info_nr_hidden(Info, N) ->
			stream_info_(Stream, N, Value)
                ;   Info == output_mode ->
                        stream_info_nr(output_options, N),
                        stream_info_(Stream, N, Handle),
                        xget(Handle, 0, Mask),
                        xget(Handle, 1, Bits),
                        output_options_string_mask_bits(Value, Mask, Bits),
                        handle_close(Handle)
		;    error(6, get_stream_info(Stream, Info, Value))
		)
	    ;
		error(5, get_stream_info(Stream, Info, Value))
	    )
	;
	    bip_error(get_stream_info(Stream, Info, Value))
	).

stream_info_wrapper(Stream, N, Value) :-
	( stream_info_nr(output_options, N) ->
	    stream_info_(Stream, N, Handle),
            output_options_from_handle(Handle, Value),
            handle_close(Handle)
	;
	    stream_info_(Stream, N, Value)
	).

:- mode stream_info_nr(?,-).
stream_info_nr(name, 0).
%stream_info_nr(mode, 2).	% old-style mode
%stream_info_nr(physical_stream, 4).	% hidden
stream_info_nr(aliases, 3).
stream_info_nr(system_use, 7).
stream_info_nr(line, 5).
stream_info_nr(offset, 6).
stream_info_nr(prompt, 1).
stream_info_nr(prompt_stream, 8).
stream_info_nr(fd, 9).
stream_info_nr(port, 10).
stream_info_nr(connection, 11).
stream_info_nr(reprompt_only, 12).
stream_info_nr(device, 13).
stream_info_nr(mode, 15).
stream_info_nr(event, 17).
stream_info_nr(flush, 18).
stream_info_nr(yield, 19).
stream_info_nr(end_of_line, 20).
stream_info_nr(scramble, 21).
stream_info_nr(sigio, 22).
stream_info_nr(usable, 23).
stream_info_nr(macro_expansion, 24).
stream_info_nr(output_options, 25).
%stream_info_nr(print_depth, 26).	% obsolete
stream_info_nr(compress, 27).
stream_info_nr(last_written, 28).
stream_info_nr(handle, 29).
stream_info_nr(delete_file, 30).
stream_info_nr(path, 31).
stream_info_nr(reposition, 32).
stream_info_nr(encoding, 33).
stream_info_nr(input, 34).
stream_info_nr(output, 35).
stream_info_nr(end_of_stream, 36).
stream_info_nr(eof_action, 37).
stream_info_nr(event_engine, 38).
stream_info_nr(locked, 39).

stream_info_nr_hidden(physical_stream, 4).
stream_info_nr_hidden(print_depth, 26). % backward compatibility, undocumented


set_stream_property(Stream, Info, Value) :-
	set_stream_property1(Stream, Info, Value),
	!.
set_stream_property(Stream, Info, Value) :-
	bip_error(set_stream_property(Stream, Info, Value)).

    set_stream_property1(_Stream, Info, _Value) :- var(Info), !,
	set_bip_error(4).
    set_stream_property1(Stream, output_options, Options) :- !,
        write_options_create([], Handle),       % not inheriting anything
	options_to_format(Options, Handle, [], _VarNames, [], _Anons, sepia_kernel),
	stream_info_nr(output_options, I1),
	set_stream_prop_(Stream, I1, Handle),
        handle_close(Handle).
    set_stream_property1(Stream, output_mode, OptionString) :- !,
        write_options_create([], Handle),       % not inheriting anything
        output_options_string_mask_bits(OptionString, Mask, Bits),
        NewMask is xget(Handle, 0) \/ Mask,
        xset(Handle, 0, NewMask),
        NewBits is xget(Handle, 1) /\ \Mask \/ Bits,
        xset(Handle, 1, NewBits),
	stream_info_nr(output_options, I1),
	set_stream_prop_(Stream, I1, Handle),
        handle_close(Handle).
    set_stream_property1(Stream, Info, Value) :-
	( stream_info_nr(Info, Nr) -> true ; set_bip_error(6) ),
	set_stream_prop_(Stream, Nr, Value).



current_compiled_file(File, Time, Module) :-
	current_compiled_file(File, Time, Module, _Goal).


make :-
	current_compiled_file(File, Time, Module, Goal),
	    get_file_info(File, mtime) =\= Time,
	    Goal@Module,	% normally compile(File)@Module
	fail.
make.



open(File, Mode, Stream, Options) :-
	open(File, Mode, Stream),
	set_stream_options(Options, Stream), !.
open(File, Mode, Stream, Options) :-
	bip_error(open(File, Mode, Stream, Options)).

set_stream_options(Options, _) :- var(Options), !, set_bip_error(4).
set_stream_options([], _) :- !.
set_stream_options([O|Os], Stream) :- !,
	set_stream_option(O, Stream),
	set_stream_options(Os, Stream).
set_stream_options(_, _) :-
	set_bip_error(5).

    set_stream_option(Option, _) :- var(Option), !, set_bip_error(4).
    set_stream_option(alias(Name), Stream) ?- !,
	( var(Name) -> set_bip_error(4)
	; \+atom(Name) -> set_bip_error(5)
	; current_stream(Name) -> set_bip_error(192)	% ISO requirement
	; set_stream(Name, Stream)
	).
    set_stream_option(type(text), _Stream) ?- !.	% ISO (only open/4)
    set_stream_option(type(binary), Stream) ?- !,	% ISO (only open/4)
	stream_info_nr(encoding, I),
	set_stream_prop_(Stream, I, octet).
    set_stream_option(type(X), _Stream) ?- var(X), !, set_bip_error(4).
    set_stream_option(reposition(false), _Stream) ?- !.	% ISO
    set_stream_option(reposition(true), Stream) ?- !,
    	( stream_info_nr(reposition, Nr), stream_info_(Stream, Nr, true) -> true
	; set_bip_error(192) ).				% ISO
    set_stream_option(reposition(X), _Stream) ?- var(X), !, set_bip_error(4).
    set_stream_option(Option, Stream) :-
        compound(Option),
        functor(Option, Name, 1),
        !,
        arg(1, Option, Value),
        set_stream_property1(Stream, Name, Value).
    set_stream_option(_, _) :-
	set_bip_error(6).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% OPERATORS
%

:- tool( op/3,	local_op_body/4).
:- tool( global_op/3,		global_op_body/4).

local_op_body(Preced, Assoc, Op, Module):-
	op_body(local, Preced, Assoc, Op, Module), !.
local_op_body(Preced, Assoc, Op, Module):-
	bip_error(op(Preced, Assoc, Op), Module).

global_op_body(Preced, Assoc, Op, Module):-
	op_body(global, Preced, Assoc, Op, Module), !.
global_op_body(Preced, Assoc, Op, Module):-
	bip_error(global_op(Preced, Assoc, Op), Module).

% Note: unfortunately, according to ISO, op(P,A,[]) means op(P,A,[[]]).
op_body(Visible, Preced, Assoc, Ops, Module) :- nonvar(Ops), Ops=[_|_], !,
	op_body1(Visible, Preced, Assoc, Ops, Module).
op_body(Visible, Preced, Assoc, Ops, Module) :-
	op_(Visible, Preced, Assoc, Ops, Module).

op_body1(_, _, _, Ops, _) :- var(Ops), !, set_bip_error(4).
op_body1(_, _, _, [], _) :- !.
op_body1(Visible, Preced, Assoc, [Op|Ops], Module) :-
	( atom(Op) -> true ; var(Op) ),
	!,
	% report errors per-operator, if possible
	( op_(Visible, Preced, Assoc, Op, Module) -> true
	; Visible == local -> bip_error(op(Preced, Assoc, Op), Module)
	; bip_error(global_op(Preced, Assoc, Op), Module) ),
        op_body1(Visible, Preced, Assoc, Ops, Module).
op_body1(_, _, _, _, _) :- set_bip_error(5).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% read_term/3 and write_term/3 (ISO compatible)
% In case of conflict, use the rightmost option

:- export
	read_term/2,
	read_term/3.

:- tool(read_term/2, read_term_/3).
:- tool(read_term/3, read_term_/4).

read_term_(Term, Options, Module) :-
	read_term_(input, Term, Options, Module).

read_term_(Stream, Term, Options, Module) :-		% 8.14.1
	check_read_options(Options, 0, OptFlags, default, ErrFlag),
	!,
	( OptFlags /\ 2'10 =:= 0 ->   % LAYOUT_PLEASE?
            % Read unannotated, macros expanded inside read_term/7
            read_term(Stream, Term, OptFlags, ErrFlag, Vars, _HasMacros, Module),
            handle_read_options(Options, Term, Vars)
	;
            % Read annotated, expand macros, return AnnTerm in Options
            read_term(Stream, RawAnnTerm, OptFlags, ErrFlag, Vars, HasMacros, Module),
	    unannotate_term(RawAnnTerm, RawTerm),
            ( HasMacros == 1 ->
                expand_macros_annotated_(RawTerm, RawAnnTerm, Term, AnnTerm, Module),
                handle_read_options(Options, AnnTerm, Vars)
            ;
                Term = RawTerm,
                handle_read_options(Options, RawAnnTerm, Vars)
            )
        ).
read_term_(Stream, Term, Options, Module) :-
	bip_error(read_term(Stream, Term, Options), Module).

    :- mode check_read_options(?,+,-,+,-).
    check_read_options(Options, _, _, _, _) :- var(Options), !,
    	set_bip_error(4).
    check_read_options([], F, F, EF, EF) :- !.
    check_read_options([O|Os], F0, F, EF0, EF) :- !,
	check_read_option(O, F0, F1, EF0, EF1),
	check_read_options(Os, F1, F, EF1, EF).
    check_read_options(_Options, _, _, _, _) :-
    	set_bip_error(5).

    :- mode handle_read_options(+,?,+).
    handle_read_options([], _, _) :- !.
    handle_read_options([O|Os], Term, Vars) :- !,
	handle_read_option(O, Term, Vars),
	handle_read_options(Os, Term, Vars).

    % Always change the next 2 predicates together!
    :- mode check_read_option(?,+,-,+,-).
    check_read_option(Option, _, _, _, _) :- var(Option), !, set_bip_error(4).
    check_read_option(variables(_), F, F, EF, EF) :- !.
    check_read_option(variable_names(_), F0, F, EF, EF) :- !,
        F is F0 \/ 2'100.	% VARLIST_PLEASE
    check_read_option(singletons(_), F0, F, EF, EF) :- !,
        F is F0 \/ 2'100.	% VARLIST_PLEASE
    check_read_option(annotated(_), F0, F, EF, EF) :- !,
        F is F0 \/ 2'10.	% LAYOUT_PLEASE
    check_read_option(line(_), F0, F, EF, EF) :- !,
        F is F0 \/ 2'10.	% LAYOUT_PLEASE, needed for line number info
    check_read_option(syntax_errors(ErrorOption), F, F, _, ErrorOption) :-
    	syntax_error_option(ErrorOption), !.
    check_read_option(_, _, _, _, _) :- set_bip_error(6).

    % If you make a change here, change also check_read_option/5!
    % CAUTION: Term may be an annotated term - this should make no difference
    % to the variable processing, but needed for annotated/1 and line/1
    :- mode handle_read_option(+,?,+).
    handle_read_option(variables(Vs), Term, _Vars) :-
	term_variables(Term, Vs).
    handle_read_option(variable_names(Vars), _Term, Vars).
    handle_read_option(singletons(NamesSingletons), Term, NsVs) :-
	collect_variables(Term, [], Vars),
	( Vars = [] ->
	    NamesSingletons = []
	;
	    sort(0, =<, Vars, SortedVars),
	    SortedVars = [_X|Xs],
	    collect_singletons(_X, Xs, Singletons),
	    add_names(Singletons, NsVs, NamesSingletons)
	).
    handle_read_option(annotated(AnnTerm), AnnTerm, _).
    handle_read_option(line(Line), AnnTerm, _) :-
        annotated_term_line(AnnTerm, Line).
    handle_read_option(syntax_errors(_), _, _).

    %syntax_error_option(default).
    syntax_error_option(fail).
    syntax_error_option(error).
    syntax_error_option(quiet).

    collect_singletons(_X, [], [_X]).
    collect_singletons(_X, [_Y|Ys], Singletons) :-
	( _X == _Y ->
	     skip_multiples(_Y, Ys, Singletons)
	;
	     Singletons = [_X|Singletons1],
	     collect_singletons(_Y, Ys, Singletons1)
	).

    skip_multiples(_, [], []).
    skip_multiples(_X, [_Y|Ys], Singletons) :-
	( _X == _Y ->
	     skip_multiples(_Y, Ys, Singletons)
	;
	     collect_singletons(_Y, Ys, Singletons)
	).

    add_names([], _, []).
    add_names([S|Ss], NsVs, NsSs) :-
	( varnamelookup(S, NsVs, N) -> NsSs = [N=S|NsSs1] ; NsSs = NsSs1 ),
	add_names(Ss, NsVs, NsSs1).

    varnamelookup(X, [N=Y|_], N) :- X==Y, !.
    varnamelookup(X, [_|T], N):- varnamelookup(X, T, N).


:- export
	write_term/2,
	write_term/3.

:- tool(write_term/2, write_term_/3).
:- tool(write_term/3, write_term_/4).

write_term_(Term, Options, Module) :-
	write_term_(output, Term, Options, Module).

write_term_(Stream, Term, Options, Module) :-		% 8.14.2
        write_options_create(Stream, Handle),
	options_to_format(Options, Handle, [], VarNames, [], Anons, Module),
	write_term(Stream, Term, Handle, VarNames, Anons, Module),
	!,
        handle_close(Handle).
write_term_(Stream, Term, Options, Module) :-
	bip_error(write_term(Stream, Term, Options), Module).


% The following auxiliary predicates translate symbolic write-options
% to the handle-referenced C level structure (in write.c) and vice versa

:- mode options_to_format(?,+,+,-,+,-,-).   % may fail with bip_error
options_to_format(List, _, _, _, _, _, _) :- var(List), !,
        set_bip_error(4).
options_to_format([], _Handle, VN, VN, VA, VA, _) :- !.
options_to_format([O|Os], Handle, VN0, VN, VA0, VA, Module) :- !,
        option_to_format(O, Handle, VarNames, Anons, Module),
        ( var(VarNames) -> VN1 = VN0 ; VN1 = VarNames ),
        ( var(Anons) -> VA1 = VA0 ; VA1 = Anons ),
        options_to_format(Os, Handle, VN1, VN, VA1, VA, Module).
options_to_format(_, _, _, _, _, _, _) :-
        set_bip_error(5).

    option_to_format(Junk, _, _, _, _) :- var(Junk), !,
        set_bip_error(4).
    option_to_format(Atom, Handle, VN, VA, M) :- atom(Atom), !,
        Option =.. [Atom,true],
        option_to_format(Option, Handle, VN, VA, M).
    option_to_format(Junk, _, _, _, _) :- atomic(Junk), !,
        set_bip_error(5).
    option_to_format(not(Atom), Handle, VN, VA, M) :- atom(Atom), !,
        Option =.. [Atom,false],
        option_to_format(Option, Handle, VN, VA, M).
    option_to_format(precedence(P), Handle, _VN, _VA, _) :- !,
        ( var(P) -> set_bip_error(4) ; xset(Handle, 3, P) ).
    option_to_format(priority(P), Handle, _VN, _VA, _) :- !, % SICStus/SWI compat
        ( var(P) -> set_bip_error(4) ; xset(Handle, 3, P) ).
    option_to_format(variable_names(VN0), _Handle, VN, _VA, _) :- !,
        ( var(VN0) -> set_bip_error(4) ; VN = VN0 ).
    option_to_format(anonymous(VA0), _Handle, _VN, VA, _) :- !,
        ( var(VA0) -> set_bip_error(4) ; VA = VA0 ).
    option_to_format(float_precision(P), Handle, _VN, _VA, _) :- !,
        ( var(P) -> set_bip_error(4)
        ; integer(P), 0=<P -> xset(Handle, 4, P)
        ; set_bip_error(6)
        ).
    option_to_format(integer_base(B), Handle, _VN, _VA, _) :- !,
        ( var(B) -> set_bip_error(4)
        ; integer(B), 2=<B, B=<36 -> xset(Handle, 6, B)
        ; set_bip_error(6)
        ).
    option_to_format(text_max(Max), Handle, _VN, _VA, _) :- !,
        ( var(Max) -> set_bip_error(4)
        ; integer(Max), 0=<Max -> xset(Handle, 7, Max)
        ; set_bip_error(6)
        ).
    option_to_format(max_depth(D), Handle, _VN, _VA, _) :- !,
        ( var(D) -> set_bip_error(4)
        ; D==0 -> xset(Handle, 2, -1)  % full depth
        ; integer(D), D>0 -> xset(Handle, 2, D)
        ; set_bip_error(6)
        ).
    option_to_format(depth(D), Handle, _VN, _VA, _) :- !,
        ( var(D) -> set_bip_error(4)
        ; D==full -> xset(Handle, 2, -1)
        ; integer(D), D>=0 -> xset(Handle, 2, D)
        ; set_bip_error(6)
        ).
    option_to_format(Option, Handle, _VN, _VA, _) :-
        ( arg(1,Option,Arg), var(Arg) ->
            option_format(Option, _, _),
            !, set_bip_error(4)
        ;
            option_format(Option, Mask, Bits),
            !,
            NewMask is xget(Handle, 0) \/ Mask,
            xset(Handle, 0, NewMask),
            NewBits is xget(Handle, 1) /\ \Mask \/ Bits,
            xset(Handle, 1, NewBits)
        ).
    option_to_format(Option, Handle, _VN, _VA, _) :-
        ( arg(1,Option,Arg), var(Arg) ->
            option_format_multi(Option, _, _, _),
            !, set_bip_error(4)
        ;
            option_format_multi(Option, Mask1, Mask2, Bits),
            !,
            Mask is Mask1 \/ Mask2,
            NewMask is xget(Handle, 0) \/ Mask,
            xset(Handle, 0, NewMask),
            NewBits is xget(Handle, 1) /\ \Mask \/ Bits,
            xset(Handle, 1, NewBits)
        ).
    option_to_format(Option, _Handle, _VN, _VA, Module) :-
        get_flag(unknown_option, Action)@Module,
        ( Action==error -> set_bip_error(6)
        ; Action==warning ->
                printf(warning_output, "WARNING: ignoring unknown write-option %w%n", Option)
        ; Action==ignore
        ).


% This is only used to decode per-stream output_options
output_options_from_handle(Handle, Options) :-
        xget(Handle, 0, Mask),
        xget(Handle, 1, Bits),
        options_from_mask_and_bits(Mask, Bits, Options, Options1),
        write_options_create([], DefaultHandle),
        findall(Option, output_option_from_handle(Handle, DefaultHandle, Option), Options1),
        handle_close(DefaultHandle).

    %output_option_from_handle(Handle, DefaultHandle, max_depth(Depth)) :-
    %    xget(Handle, 2, Arg),
    %    Arg =\= xget(DefaultHandle, 2),
    %    ( Arg > 0 -> Depth = Arg
    %    ; Arg < 0 -> Depth = 0         % full depth
    %    ; sys_flag(1, D), Depth=D      % global print_depth
    %    ).
    output_option_from_handle(Handle, DefaultHandle, depth(Depth)) :-
        xget(Handle, 2, Arg),
        Arg =\= xget(DefaultHandle, 2),
        ( Arg == -1 -> Depth = full ; Depth = Arg ).
    output_option_from_handle(Handle, DefaultHandle, Option) :-
        option_handle_field(Option, Arg, I),
        xget(Handle, I, Arg),
        Arg =\= xget(DefaultHandle, I).

    option_handle_field(float_precision(Prec),	        Prec,	4).
    option_handle_field(integer_base(Base), 	        Base,	6).
    option_handle_field(precedence(Prec),     	        Prec,   3).
    option_handle_field(text_max(Max),	                Max,    7).


    % Generate the option terms needed to set the subset of bits in
    % TargetBits that is marked by TargetMask (others are ignored).
    % The idea of the algorithm is to try to use multi-feature options
    % first to fix their "fixed bits", then try single-feature options
    % to fix all remaining bits.
    options_from_mask_and_bits(TargetMask, TargetBits, Opts, Opts0) :-
        ( TargetMask =:= 0 ->
            Opts = Opts0
        ;
            option_format_multi(Opt0, OptMaskFixed, OptMaskOverridable, OptBits),

            OptMask is OptMaskFixed \/ OptMaskOverridable,

            % this option affects a subset of the target bits
            TargetMask /\ OptMask =:= OptMask,

            % this option sets the OptMaskFixed as required
            WantedBits is TargetBits /\ OptMaskFixed,
            WantedBits =:= OptBits /\ OptMaskFixed
        ->
            % commit to this option
            Opts = [Opt0|Opts1],

            % forget the bits that are already correct
            GoodBitsMask is OptMaskFixed \/ (\xor(OptBits,TargetBits) /\ OptMaskOverridable),
            TargetMask1 is TargetMask /\ \GoodBitsMask,
            options_from_mask_and_bits(TargetMask1, TargetBits, Opts1, Opts0)

        ;
            option_format(Opt0, OptMask, OptBits),

            % this option affects a subset of the target bits
            TargetMask /\ OptMask =:= OptMask,

            % this option sets the bits as required
            WantedBits is TargetBits /\ OptMask,
            WantedBits =:= OptBits
        ->
            % commit to this option
            Opts = [Opt0|Opts1],

            % forget these bits 
            TargetMask1 is TargetMask /\ \OptMask,
            options_from_mask_and_bits(TargetMask1, TargetBits, Opts1, Opts0)
        ;
            UnknownBits is TargetMask /\ TargetBits,
            Opts = [unknown(UnknownBits)|Opts0]
        ).


% Default output mode for toplevel and debugging is now stored
% as an attribute of the null stream.  See also [gs]et_flag/2
output_mode(Mode) :-
        get_stream_info(null, output_mode, Mode).


% Bit-encoded output options
%
% The table is split into
% - single feature (possibly multi-bit) options option_format/3
% - feature-combination options option_format_multi/4
% The split is necessary for the reverse conversion algorithm.
% Multi-bit options must share the same AffectedBitsMask field.
% In case of duplicate/compatibility option names, list the more
% desirable one first - it will then be used for reverse conversion.
% CAUTION: The numeric constants must match the definitions in ec_io.h!

% option_format(?Option, -AffectedBitsMask, -BitPattern).
:- mode option_format(?,-,-).
option_format(variables(anonymous),	16'4030, 16'4000).	% VAR_ANON
option_format(variables(default),	16'4030, 16'0000).
option_format(variables(raw),		16'4030, 16'0010).	% VAR_NUMBERS
option_format(variables(full),		16'4030, 16'0020).	% VAR_NAMENUM
option_format(attributes(none),		16'0500, 16'0000).
option_format(attributes(pretty),	16'0500, 16'0100).	% ATTRIBUTE
option_format(attributes(full),		16'0500, 16'0400).	% STD_ATTR
option_format(as(term),			16'1200, 16'0000).
option_format(as(clause),		16'1200, 16'1000).	% WRITE_CLAUSE
option_format(as(goal),			16'1200, 16'0200).	% WRITE_GOAL
option_format(newlines(true),		16'2000, 16'2000).	% DONT_QUOTE_NL
option_format(newlines(false),		16'2000, 16'0000).
%option_format(brace_terms(true),	16'02000000, 16'02000000).	% NOBRACES
%option_format(brace_terms(false),	16'02000000, 16'00000000).
option_format(dotlists(true),		16'0004, 16'0004).	% DOTLIST
option_format(dotlists(false),		16'0004, 16'0000).
option_format(transform(true),		16'0800, 16'0000).
option_format(transform(false),		16'0800, 16'0800).	% NO_MACROS
option_format(quoted(true),		16'0008, 16'0008).	% QUOTED
option_format(quoted(false),		16'0008, 16'0000).
option_format(numbervars(true),		16'8000, 16'8000).	% OUT_DOLLAR_VAR
option_format(numbervars(false),	16'8000, 16'0000).
option_format(portrayed(true),		16'0040, 16'0040).	% PRINT_CALL
option_format(portrayed(false),		16'0040, 16'0000).
option_format(fullstop(true),           16'20000,16'20000).	% TERM_FULLSTOP
option_format(fullstop(false),          16'20000,16'00000).
option_format(nl(true),                 16'40000,16'40000).	% TERM_NEWLINE
option_format(nl(false),                16'40000,16'00000).
option_format(flush(true),              16'80000,16'80000).	% TERM_FLUSH
option_format(flush(false),             16'80000,16'00000).
option_format(partial(true),            16'0100000,16'100000).	% TERM_CONTINUE
option_format(partial(false),           16'0100000,16'000000).
option_format(spacing(compact),         16'01000080, 16'01000080). % WRITE_COMPACT|WRITE_NOPSPC
option_format(spacing(after_comma),     16'01000080, 16'01000000). % WRITE_NOPSPC
option_format(spacing(generous),        16'01000080, 16'00000000).
option_format(compact(true),		16'01000080, 16'01000080). % WRITE_COMPACT
option_format(compact(false),		16'01000080, 16'00000000).
option_format(cycles(true),             16'04000000, 16'04000000). % TERM_CYCLES
option_format(cycles(false),            16'04000000, 16'00000000).

% Options that set multiple fields together
% option_format_multi(?Option, -BitMask, -OverridableBits, -BitsToSet).
option_format_multi(ignore_ops(true),   16'12000001, 16'00000804, 16'02000805).	% CANONICAL|NOBRACES|NO_MACROS
option_format_multi(ignore_ops(false),  16'12000001, 16'00000804, 16'00000000).
option_format_multi(portable(true),     16'12000001, 16'00000004, 16'10000001).	% CANONICAL|COMMAOP
option_format_multi(portable(false),    16'12000001, 16'00000004, 16'00000000).
option_format_multi(operators(true),    16'12000001, 16'00000000, 16'00000000).
option_format_multi(operators(false),   16'12000001, 16'00000000, 16'02000001).	% CANONICAL|NOBRACES


%
% term_string(?Term, ?String, +Options)
% Options that don't apply to the direction are ignored.
%

:- export term_string/3.
:- tool(term_string/3, term_string_/4).

term_string_(T, S, Options, Module) :-
        ( separate_options(Options, ROptions, WOptions, Module) ->
            term_string_(T, S, Options, ROptions, WOptions, Module)
        ;
            bip_error(term_string(T, S, Options), Module)
        ).

term_string_(T, S, _Options, _, WOptions, Module) :- var(S), !,
	open(string(""), write, Stream),
	write_term_(Stream, T, [
	    attributes(full),quoted(true),numbervars(true),
	    variables(raw),depth(full),transform(false)|WOptions], Module),
	stream_info_(Stream, 0, S),  % = get_stream_info(Stream,name,S)
	close(Stream).
term_string_(T, S, Options, ROptions, _, Module) :- string(S), !,
        (
            open(string(S), read, Stream), % auto-close on fail
            read_term_(Stream, T0, [syntax_errors(quiet)|ROptions], Module),
            % fail if read_term already encountered end_of_stream
            \+ stream_info_(Stream, 36, past),  % = get_stream_info(Stream, end_of_stream, past),
            read_token_(Stream, end_of_file, _, Module)
        ->
            close(Stream),
            T = T0
        ;
            % fail if 'quiet' or 'fail' was explicitly requested
            nonmember(syntax_errors(quiet), ROptions),
            nonmember(syntax_errors(fail), ROptions),
            error(7, term_string(T, S, Options), Module)
        ).
term_string_(T, S, Options, _, _, Module) :-
	error(5, term_string(T, S, Options), Module).

    :- mode separate_options(?,-,-,+).
    separate_options([], [], [], _) :- !.
    separate_options([Option|Options], ROptions, WOptions, M) ?- !,
        ( var(Option) -> set_bip_error(4)
        ; is_read_option(Option) ->
            ROptions = [Option|ROptions1],
            separate_options(Options, ROptions1, WOptions, M)
        ; is_write_option(Option) ->
            WOptions = [Option|WOptions1],
            separate_options(Options, ROptions, WOptions1, M)
        ; callable(Option) ->
            get_flag(unknown_option, Action)@M,
            ( Action==error -> set_bip_error(6)
            ; Action==warning -> printf(warning_output, "WARNING: ignoring unknown term_string-option %w%n", Option)
            %; Action==ignore -> true
            ),
            separate_options(Options, ROptions, WOptions, M)
        ; set_bip_error(5)
        ).
    get_read_options(_, _, _, _) :-
        set_bip_error(5).

    :- mode is_read_option(+).
    is_read_option(variables(Vars)) :- (var(Vars)->true;Vars==[];Vars=[_|_]).
    is_read_option(variable_names(_)).
    is_read_option(singletons(_)).
    is_read_option(annotated(_)).
    is_read_option(line(_)).
    is_read_option(syntax_errors(_)).

    :- mode is_write_option(+).
    is_write_option(Atom) :- atom(Atom),
        Option=..[Atom,true], is_write_option(Option).
    is_write_option(not(Atom)) :- atom(Atom),
        Option=..[Atom,false], is_write_option(Option).
    is_write_option(precedence(_)).
    is_write_option(priority(_)).
    is_write_option(variable_names(_)).
    is_write_option(anonymous(_)).
    is_write_option(float_precision(_)).
    is_write_option(integer_base(_)).
    is_write_option(text_max(_)).
    is_write_option(max_depth(_)).
    is_write_option(depth(_)).
    is_write_option(variables(Mode)) :- atom(Mode), Mode\==[].
    is_write_option(attributes(_)).
    is_write_option(as(_)).
    is_write_option(newlines(_)).
    is_write_option(dotlists(_)).
    is_write_option(transform(_)).
    is_write_option(quoted(_)).
    is_write_option(numbervars(_)).
    is_write_option(portrayed(_)).
    is_write_option(fullstop(_)).
    is_write_option(nl(_)).
    is_write_option(flush(_)).
    is_write_option(partial(_)).
    is_write_option(spacing(_)).
    is_write_option(compact(_)).
    is_write_option(cycles(_)).
    is_write_option(ignore_ops(_)).
    is_write_option(portable(_)).
    is_write_option(operators(_)).


%
% term_string(?Term, ?String)
%

:- export term_string/2.
:- skipped term_string/2.
term_string_body(T, S, Module) :- var(S), !,
	open(string(""), write, Stream),
	writeq_(Stream, T, Module),
	stream_info_(Stream, 0, S),  % = get_stream_info(Stream,name,S)
	close(Stream).
term_string_body(T, S, Module) :- string(S), !,
        (
            open(string(S), read, Stream),
            read_term(Stream, T0, 0, quiet, _, _, Module),
            % fail if read_term already encountered end_of_stream
            \+ stream_info_(Stream, 36, past),  % = get_stream_info(Stream, end_of_stream, past),
            read_token_(Stream, end_of_file, _, Module)
        ->
            close(Stream),
            T = T0
        ;
            error(7, term_string(T, S))
        ).
term_string_body(T, S, _Module) :-
	error(5, term_string(T, S)).


% Backward compatibility
readvar(Stream, Term, Vars, Module) :-
	read_term(Stream, Term, 2'1100, default, Vars, _, Module). % VARLIST_PLEASE|READVAR_PAIRS



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/**** REMEMBER TO UPDATE annotated_term used in raw form by expand_macros
 **** and friends when changing the definition here
 **** definition now moved to kernel.pl, update it there
:- export struct(annotated_term(
	term,		% var, atomic or compound
	type,		% atom or var/1
	file,		% atom
	line,		% integer
	from,		% integer
	to		% integer
	% may be extended in future
    )).
****/

:- export read_annotated/2.
:- tool(read_annotated/2, read_annotated_/3).

read_annotated_(Stream, AnnTerm, Module) :-
	read_term(Stream, RawAnnTerm, 2, default, [], HasMacros, Module), % LAYOUT_PLEASE
	( HasMacros == 1 ->
	    unannotate_term(RawAnnTerm, RawTerm),
	    expand_macros_annotated_(RawTerm, RawAnnTerm, _Term, AnnTerm, Module)
	;
	    AnnTerm = RawAnnTerm
	).


:- export read_annotated/3.
:- tool(read_annotated/3, read_annotated_/4).

read_annotated_(Stream, Term, AnnTerm, Module) :-
	read_term(Stream, RawAnnTerm, 2, default, [], HasMacros, Module), % LAYOUT_PLEASE
	unannotate_term(RawAnnTerm, RawTerm),
	( HasMacros == 1 ->
	    expand_macros_annotated_(RawTerm, RawAnnTerm, Term, AnnTerm, Module)
	;
	    Term = RawTerm, AnnTerm = RawAnnTerm
	).


unannotate_term(end_of_file, Term) :- -?->
	Term = end_of_file.
unannotate_term(annotated_term{term:TermAnn}, Term) :- -?->
	( compound(TermAnn) ->
	    functor(TermAnn, F, A),
	    functor(Term, F, A),
	    unannotate_term_args(A, TermAnn, Term)
	;
	    Term = TermAnn
	).

    unannotate_term_args(0, _TermAnn, _Term) :- !.
    unannotate_term_args(I, TermAnn, Term) :-
	    I1 is I-1,
	    arg(I, TermAnn, AnnArg),
	    arg(I, Term, Arg),
	    unannotate_term(AnnArg, Arg),
	    unannotate_term_args(I1, TermAnn, Term).


% Get the earliest source line of an annotated term
annotated_term_line(annotated_term{term:TermAnn,line:Line0}, Line) ?- 
        first_subterm_line(TermAnn, Line0, Line).

    first_subterm_line(TermAnn, Line0, Line) :-
	( compound(TermAnn), arity(TermAnn) =< 2 ->
	    % 1st argument _could_ be textually before the functor
	    arg(1, TermAnn, AnnArg),
	    annotated_term{term:ArgAnn,line:ArgLine} = AnnArg,
	    Line1 is min(Line0,ArgLine),
	    first_subterm_line(ArgAnn, Line1, Line)
	;
	    Line=Line0
	).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% write the header for a .eco file

dump_header(Out) :-
	% magic .eco header (see procedure.c)
	put(Out, 16'EC), put(Out, 16'1C), put(Out, 16'29),
	put(Out, 16'16),	% ECO_CURRENT_VERSION, see procedure.c
	% flush before switching to scramble mode
	flush(Out),
	% next line contains key that must be used in the .eco loader
	set_stream_property(Out, scramble, 73540),
	% 8 random bytes to make decryption more difficult
	% (it may be better to have one after every dumped term)
	random(R), get_flag(unix_time, T),
	R1 is R/\255, R2 is R>>8/\255, R3 is R>>16/\255, R4 is R>>24/\255,
	R5 is T/\255, R6 is T>>8/\255, R7 is T>>16/\255, R8 is T>>24/\255,
	put(Out, R1), put(Out, R7), put(Out, R3), put(Out, R5),
	put(Out, R2), put(Out, R8), put(Out, R4), put(Out, R6).


% write a term in .eco format

dump_term(Out, Term, Module) :-
        term_to_bytes_(Term, String, Module),
        string_length(String, Length),
        write_integer(Out, Length),
        printf(Out, "%Tw", String).             % no macros!

write_integer(Out, N) :-
        Byte0 is N /\ 16'ff,
        Byte1 is (N >> 8) /\ 16'ff,
        Byte2 is (N >> 16) /\ 16'ff,
        Byte3 is (N >> 24) /\ 16'ff,
        put(Out, Byte3),
        put(Out, Byte2),
        put(Out, Byte1),
        put(Out, Byte0).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

:- mode file_query_body(++, +, +).
file_query_body(call(Goal), _, M) :-		% call/1 forces execution
	!,
	call(Goal)@M.
file_query_body((A, B), Proc, M) :-
	!,
	file_query_body(A, Proc, M),
	file_query_body(B, Proc, M).
file_query_body((A->B;C), Proc, M) :-
	!,
	(file_query_body(A, Proc, M) ->
	    file_query_body(B, Proc, M)
	;
	    file_query_body(C, Proc, M)
	).
file_query_body((A;B), Proc, M) :-
	!,
	(
	    file_query_body(A, Proc, M)
	;
	    file_query_body(B, Proc, M)
	).
file_query_body([File|L], Proc, M) :-
	!,
	call_proc(Proc, File, M),
	(L == [] ->
	    true
	;
	    file_query_body(L, Proc, M)
	).
file_query_body(compile(File), Proc, M) :-
	!,
	(File = [_|_] -> 
	    file_query_body(File, Proc, M)
	;
	    call_proc(Proc, File, M)
	).
file_query_body(ensure_loaded(Files), Proc, M) :-
	!,
	(Files = [_|_] -> 
	    file_query_body(Files, Proc, M)
	;
	    call_proc(Proc, Files, M)
	).
file_query_body(:-(Goal), Proc, M) :-
        !,
        file_query_body(Goal, Proc, M).
file_query_body(?-(Goal), Proc, M) :-
        !,
        file_query_body(Goal, Proc, M).
file_query_body(meta_attribute(_, _), _, M) :-
        !,
        meta_attribute(M, []).
file_query_body(Goal, _Proc, M) :-
	execute(Goal) ->
	    call(Goal)@M
	;
	    true.

:- mode execute(+).
execute(use_module(_)).
execute(define_struct(_)).	% library(structures)
execute(erase_struct(_)).
execute(op(_, _, _)).
execute(global_op(_, _, _)).
execute(local_op(_, _, _)).
execute(set_flag(A, _)) :- allowed_flag(A).
execute(get_flag(_, _)).
execute(define_global_macro(_, _, _)).
execute(define_local_macro(_, _, _)).
execute(define_macro(_, _, _)).
execute(erase_macro(_)).
execute(set_chtab(_, _)).
execute(asserta(_)).
execute(assert(_)).
execute(assertz(_)).
execute(compile_term(_)).
execute(cprolog).
execute(quintus).
execute(bsi).
execute(sicstus).

:- mode allowed_flag(+).
allowed_flag(library_path).
allowed_flag(macro_expansion).
allowed_flag(prolog_suffix).

call_proc(Proc, File, M) :-
	copy_term(Proc, Copy),
	arg(1, Copy, File),
	call(Copy)@M.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%	EXEC
%

exec(Command, Streams) :-
	exec(Command, Streams, Pid, 2),	% fails on error
	!,
	wait(Pid, Code),		% waitpid()
	( Code /\ 8'377 =:= 0 ->	% process exited normally
	    Status is Code >> 8 /\ 8'377,
	    Err is Status - 128,
	    (Err > 0 ->
		set_last_errno(Err),
		error(170, exec(Command, Streams))
	    ;
		true
	    )
	; Code /\ 8'377 =:= 8'177 ->	% process stopped
	    error(175, exec(Command, Streams))
	;				% process died
	    error(174, exec(Command, Streams))
	).
exec(Command, Streams) :-
	bip_error(exec(Command, Streams)).


exec(Command, Streams, Pid) :-
	exec(Command, Streams, Pid, 0), !.
exec(Command, Streams, Pid) :-
	bip_error(exec(Command, Streams, Pid)).

exec_group(Command, Streams, Pid) :-
	exec(Command, Streams, Pid, 1), !.
exec_group(Command, Streams, Pid) :-
	bip_error(exec_group(Command, Streams, Pid)).
	

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%	Sh
%

system(X) :-
	( get_flag('_system'/1, defined, on) ->
	    '_system'(X)
	;
	    exec(['/bin/sh', '-c', X], [])
	).

sh(X) :-
	system(X).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%	FILES
%
get_file_info(File, Name, Value) :-
	check_atom_string(File),
	check_var_or_atom(Name),
	check_var_or_atomic(Value),
	!,
	expand_filename(File, ExpandedFile, 1),  % EXPAND_STANDARD
	do_get_file_info(ExpandedFile, Name, Value).
get_file_info(File, Name, Value) :-
	bip_error(get_file_info(File, Name, Value)).


% This predicate expects an already expanded file name!
do_get_file_info(File, device, X) :-
	sys_file_flag(File, 9, X).
do_get_file_info(File, inode, X) :-
	sys_file_flag(File, 1, X).
do_get_file_info(File, mode, X) :-
	sys_file_flag(File, 0, X).
do_get_file_info(File, nlink, X) :-
	sys_file_flag(File, 2, X).
do_get_file_info(File, uid, X) :-
	sys_file_flag(File, 3, X).
do_get_file_info(File, uname, X) :-
	sys_file_flag(File, 15, X).
do_get_file_info(File, gid, X) :-
	sys_file_flag(File, 4, X).
do_get_file_info(File, gname, X) :-
	sys_file_flag(File, 16, X).
do_get_file_info(File, size, X) :-
	sys_file_flag(File, 5, X).
do_get_file_info(File, atime, X) :-
	sys_file_flag(File, 6, X).
do_get_file_info(File, adate, X) :-
	sys_file_flag(File, 12, X).
do_get_file_info(File, mtime, X) :-
	sys_file_flag(File, 7, X).
do_get_file_info(File, mdate, X) :-
	sys_file_flag(File, 13, X).
do_get_file_info(File, ctime, X) :-
	sys_file_flag(File, 8, X).
do_get_file_info(File, cdate, X) :-
	sys_file_flag(File, 14, X).
do_get_file_info(File, blksize, X) :-
	sys_file_flag(File, 11, X).
do_get_file_info(File, blocks, X) :-
	sys_file_flag(File, 10, X).
do_get_file_info(File, readable, X) :-
	process_file_permission(readable, N),
	sys_file_flag(File, N, X).
do_get_file_info(File, writable, X) :-
	process_file_permission(writable, N),
	sys_file_flag(File, N, X).
do_get_file_info(File, executable, X) :-
	process_file_permission(executable, N),
	sys_file_flag(File, N, X).
do_get_file_info(File, type, Type) :-
	sys_file_flag(File, 0, Mode),
	TypeBits is Mode /\ 8'170000,
	( TypeBits == 8'010000 -> Type = fifo
	; TypeBits == 8'020000 -> Type = char_device
	; TypeBits == 8'040000 -> Type = directory
	; TypeBits == 8'060000 -> Type = block_device
	; TypeBits == 8'100000 -> Type = file
	; TypeBits == 8'120000 -> Type = link
	; TypeBits == 8'140000 -> Type = socket
	; Type = unknown
	).
do_get_file_info(File, compiled_time, Time) :-
	current_compiled_file(File, Time, _Module, _Goal).


% tool interfaces must be set to skipped explicitely
:- skipped
	file_query/2,
	global_op/3,
	op/3,
	read_token/2.

% Set all output predicates to skipped in order not to trace the
% flush event handler (io_yield_handler) when it happens.
:- skipped
	flush/1,
	display/1,
	display/2,
	nl/0,
	nl/1,
	put/1,
	put/2,
	print/1,
	print/2,
	printf/2,
	printf/3,
	tyo/1,
	tyo/2,
	write/1,
	write/2,
	write_canonical/1,
	write_canonical/2,
	write_exdr/2,
	write_term/2,
	write_term/3,
	writeln/1,
	writeln/2,
	writeq/1,
	writeq/2.

:- untraceable
	make/0.

:- export
	file_query/2.
