1/* Part of SWI-Prolog 2 3 WWW: http://www.swi-prolog.org 4 Copyright (c) 2020-2021, SWI-Prolog Solutions b.v. 5 All rights reserved. 6 7 Redistribution and use in source and binary forms, with or without 8 modification, are permitted provided that the following conditions 9 are met: 10 11 1. Redistributions of source code must retain the above copyright 12 notice, this list of conditions and the following disclaimer. 13 14 2. Redistributions in binary form must reproduce the above copyright 15 notice, this list of conditions and the following disclaimer in 16 the documentation and/or other materials provided with the 17 distribution. 18 19 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 20 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 21 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 22 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 23 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 24 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 25 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 26 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 27 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 28 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 29 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 30 POSSIBILITY OF SUCH DAMAGE. 31*/ 32 33:- module(sicstus4, 34 [ nonmember/2, % ?Element, ?List 35 statistics/2, % ?Key, ?Value 36 op(1100, xfy, (do)) 37 ]). 38:- use_module(library(arithmetic)). 39:- reexport(sicstus, 40 [ (block)/1, 41 if/3, 42 use_module/3, 43 bb_put/2, 44 bb_get/2, 45 bb_delete/2, 46 bb_update/3, 47 is_mutable/1 as mutable, 48 create_mutable/2, 49 get_mutable/2, 50 update_mutable/2, 51 sicstus_is_readable_stream/1, 52 read_line/1, 53 read_line/2, 54 trimcore/0, 55 prolog_flag/3, 56 op(1150, fx, (block)), 57 op(1150, fx, (mode)), 58 op(900, fy, (spy)), 59 op(900, fy, (nospy)) 60 ]). 61 62/** <module> SICStus 4 compatibility library 63 64This library is intended to be activated using the directive below in 65files that are designed for use with SICStus Prolog 4. The changes are in 66effect until the end of the file and in each file loaded from this file. 67 68 == 69 :- expects_dialect(sicstus4). 70 == 71 72This library only provides compatibility with version 4 of SICStus Prolog. 73For SICStus Prolog 3 compatibility, use library(dialect/sicstus) instead. 74 75@tbd The dialect-compatibility packages are developed in a 76 `demand-driven' fashion. Please contribute to this package. 77*/ 78 79% Note: Although the do operator is declared here, do loops currently 80% aren't emulated by library(dialect/sicstus4). 81:- op(1100, xfy, user:(do)). 82 83 84 /******************************* 85 * LIBRARY SETUP * 86 *******************************/ 87 88%% push_sicstus4_library 89% 90% Pushes searching for dialect/sicstus4 in front of every library 91% directory that contains such as sub-directory. 92 93push_sicstus4_library :- 94 ( absolute_file_name(library(dialect/sicstus4), Dir, 95 [ file_type(directory), 96 access(read), 97 solutions(all), 98 file_errors(fail) 99 ]), 100 asserta((user:file_search_path(library, Dir) :- 101 prolog_load_context(dialect, sicstus4))), 102 fail 103 ; true 104 ). 105 106 107:- push_sicstus4_library. 108 109 110%% setup_dialect 111% 112% Further dialect initialization. 113% 114% sicstus4 currently performs the same initialization 115% as the sicstus (SICStus 3) dialect. 116 117setup_dialect :- sicstus:setup_dialect. 118 119 120 /******************************* 121 * LIBRARY MODULES * 122 *******************************/ 123 124%% rename_module(?SICStus4Module, ?RenamedSICStus4Module) is nondet. 125% 126% True if RenamedSICStus4Module is the name that we use for the 127% SICStus 4 native module SICStus4Module. We do this in places where 128% the module-name conflicts. All explicitly qualified goals are 129% mapped to the SICStus 4 equivalent of the module. 130 131:- multifile 132 rename_module/2. 133 134systemgoal_expansion(M:Goal, SicstusM:Goal) :- 135 atom(M), 136 rename_module(M, SicstusM), 137 prolog_load_context(dialect, sicstus4). 138 139 140% SICStus 4 copy_term/2 behaves like SWI copy_term_nat/2. 141usergoal_expansion(copy_term(Term, Copy), copy_term_nat(Term, Copy)) :- 142 prolog_load_context(dialect, sicstus4). 143 144 145%% nonmember(?Element, ?List) is semidet. 146% 147% True if Element doesn't unify with any element in List. 148% No variables are bound. 149 150nonmember(Element, List) :- \+ memberchk(Element, List). 151 152% As of SICStus 4.6.0, the following statistics/2 keys are still missing: 153% Introduced in SICStus 4.0: 154% * defragmentation 155% Introduced in SICStus 4.1: 156% * choice_used, choice_free 157% * defrag_count, defrag_time 158% * dpgc_count, dpgc_time 159% * memory_culprit 160% * memory_buckets 161% Introduced in SICStus 4.3: 162% * jit_count, jit_time 163 164statistics(total_runtime, Stats) :- !, system:statistics(runtime, Stats). 165% The following keys were introduced with SICStus Prolog 4.1. 166statistics(memory_used, BytesUsed) :- !, system:statistics(memory, [BytesUsed, _]). 167statistics(memory_free, BytesFree) :- !, system:statistics(memory, [_, BytesFree]). 168statistics(global_stack_used, BytesUsed) :- !, system:statistics(global_stack, [BytesUsed, _]). 169statistics(global_stack_free, BytesFree) :- !, system:statistics(global_stack, [_, BytesFree]). 170statistics(local_stack_used, BytesUsed) :- !, system:statistics(local_stack, [BytesUsed, _]). 171statistics(local_stack_free, BytesFree) :- !, system:statistics(local_stack, [_, BytesFree]). 172statistics(trail_used, BytesUsed) :- !, system:statistics(trail, [BytesUsed, _]). 173statistics(trail_free, BytesFree) :- !, system:statistics(trail, [_, BytesFree]). 174statistics(atoms_used, BytesUsed) :- !, system:statistics(atom_space, BytesUsed). 175statistics(atoms_nbused, CountUsed) :- !, system:statistics(atoms, CountUsed). 176statistics(atoms_nbfree, CountFree) :- !, CountFree = 0. 177statistics(ss_global, Count) :- !, system:statistics(stack_shifts, [Count, _, _]). 178statistics(ss_local, Count) :- !, system:statistics(stack_shifts, [_, Count, _]). 179statistics(ss_time, Time) :- !, system:statistics(stack_shifts, [_, _, Time]). 180statistics(gc_count, Count) :- !, system:statistics(garbage_collection, [Count, _, _|_]). 181statistics(gc_freed, BytesFreed) :- !, system:statistics(garbage_collection, [_, BytesFreed, _|_]). 182statistics(gc_time, Time) :- !, system:statistics(garbage_collection, [_, _, Time|_]). 183statistics(agc_count, Count) :- !, system:statistics(atom_garbage_collection, [Count, _, _]). 184statistics(agc_freed, BytesFreed) :- !, system:statistics(atom_garbage_collection, [_, BytesFreed, _]). 185statistics(agc_time, Time) :- !, system:statistics(atom_garbage_collection, [_, _, Time]). 186statistics(dcgc_count, Count) :- !, system:statistics(clause_garbage_collection, [Count, _, _]). 187statistics(dcgc_time, Time) :- !, system:statistics(clause_garbage_collection, [_, _, Time]). 188 189:- use_module(sicstus, [statistics/2 as sicstus3_statistics]). 190statistics(Keyword, Value) :- sicstus3_statistics(Keyword, Value). 191 192% Provide (\)/2 as arithmetic function. Ideally, we should be able to 193% bind multiple names to built-in functions. This is rather slow. We 194% could also consider adding \ internally, but not turning it into an 195% operator. 196 197:- arithmetic_function(user:(\)/2). 198 199user(\(X,Y,R)) :- 200 R is xor(X,Y)