From 6f1f90eabaddf921f6bb4c537e9d7839800356c4 Mon Sep 17 00:00:00 2001 From: Jan Wielemaker Date: Thu, 2 Jan 2025 15:12:53 +0100 Subject: [PATCH] MODIFIED: Turn SICStus `splfr` script into a SWI-Prolog _app_ Allows for ``swipl splfr [option..] input ...`` Patch also fixes typing in ``sicstus.h``, check the return of PL_put_term() and adds SP_cons_functor(). --- app/splfr.pl | 177 +++++++++++++++++++++++++++ library/dialect/sicstus/swipl-lfr.pl | 130 -------------------- src/CMakeLists.txt | 4 +- src/compat/sicstus.h | 38 +++++- 4 files changed, 213 insertions(+), 136 deletions(-) create mode 100755 app/splfr.pl delete mode 100755 library/dialect/sicstus/swipl-lfr.pl diff --git a/app/splfr.pl b/app/splfr.pl new file mode 100755 index 0000000000..aeec98bdf0 --- /dev/null +++ b/app/splfr.pl @@ -0,0 +1,177 @@ +/* Part of SWI-Prolog + + Author: Jan Wielemaker + E-mail: jan@swi-prolog.org + WWW: http://www.swi-prolog.org + Copyright (c) 2010-2024, VU University Amsterdam + SWI-Prolog Solutions b.v. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS + FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, + INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, + BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; + LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + POSSIBILITY OF SUCH DAMAGE. +*/ + +:- initialization(main, main). + +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +This file emulates SICStus the splfr program, which extracts +declarations for foreign resources from a Prolog file, creates a +wrapper, compiles this and finally generates a shared object that is +automatically loaded into SWI-Prolog. + +Note that this implementation is only partial. It was written for +running Alpino (www.let.rug.nl/vannoord/alp/Alpino/) and only processes +the commandline options needed for this. + +To use this facility, copy this file to a directory in your $PATH and +edit the first line to reflect the location of SWI-Prolog. +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ + +:- use_module(library(prolog_source)). +:- use_module(library(qpforeign)). +:- use_module(library(apply)). +:- use_module(library(debug)). +:- use_module(library(option)). +:- use_module(library(dialect)). +:- use_module(library(main)). + +:- debug(swipl_frl). + +main(Argv) :- + append(Opts, [Stop|Rest], Argv), + ( Stop == '--' + -> Inputs = Rest + ; \+ sub_atom(Stop, 0, _, _, '--') + -> Inputs = [Stop|Rest] + ), + !, + argv_options(Opts, _, Options), + ( catch(swipl_frl(Inputs, Options), Error, + ( print_message(error, Error), + halt(1) + )) + -> halt + ; print_message(error, goal_failed(swipl_frl(Argv))), + halt(1) + ). + +opt_type(cflag, cflag, atom). + +opt_help(help(header), + "Emulator for SICStus splfr"). +opt_help(help(usage), + " [option ...] inputs ..."). +opt_help(help(footer), + "Very incomplete!"). +opt_help(cflag, + "Flags to pass to the C compiler"). + +swipl_frl(Positional, Options) :- + partition(plfile, Positional, PlFiles, Rest), + PlFiles = [PlFile], + !, + file_name_extension(Base, _Ext, PlFile), + create_glue(PlFile, GlueFile), + option(cflag(CFlags), Options, ''), + atomic_list_concat([GlueFile,CFlags|Rest], ' ', Cmd0), + format(atom(Cmd), 'swipl-ld -shared -o ~w ~w', [Base, Cmd0]), + debug(swipl_frl, '~w', [Cmd]), + shell(Cmd). +swipl_frl(_Positional, _Options) :- + argv_usage(debug). + +plfile(Name) :- + \+ sub_atom(Name, 0, _, _, -), + file_name_extension(_, pl, Name). + +%! create_glue(+PrologFile, -GlueFile) is det +% +% Create the glue foreign resources in PrologFile. The glue is +% written to GlueFile. + +create_glue(File, Glue) :- + file_name_extension(Base, _Ext, File), + atom_concat(Base, '_swi_glue', GlueBase), + file_name_extension(GlueBase, c, Glue), + load_resource_decls(File, Module), + create_module_glue(Module, Base, GlueBase). + +create_module_glue(Module, Base, GlueBase) :- + Module:foreign_resource(Resource, _), + make_foreign_resource_wrapper(Module:Resource, Base, GlueBase). + + +%! load_resource_decls(+Source, -Module) +% +% Load SICSTus/Quintus resource declarations from Source. Module +% is the module in which the resources are loaded. + +load_resource_decls(Source, Module) :- + expects_dialect(sicstus), + prolog_canonical_source(Source, Id), + setup_call_cleanup(prolog_open_source(Id, In), + process(In, no_module, Module), + prolog_close_source(In)). + + +process(In, State0, Module) :- + prolog_read_source_term(In, _, Expanded, []), + process_terms(Expanded, State0, State1), + ( State1 = end_of_file(EndState) + -> state_module(EndState, Module) + ; process(In, State1, Module) + ). + +process_terms([], State, State) :- !. +process_terms([H|T], State0, State) :- + !, + process_term(H, State0, State1), + ( State1 == end_of_file + -> State = State1 + ; process_terms(T, State1, State) + ). +process_terms(T, State0, State) :- + process_term(T, State0, State). + +process_term(end_of_file, State, end_of_file(State)) :- !. +process_term((:- module(Name, _)), _, module(Name)) :- + !, + clean_resources(Name). +process_term(Term, State, State) :- + foreign_term(Term, Assert), + !, + state_module(State, M), + assertz(M:Assert). +process_term(_, State, State). + +foreign_term(foreign_resource(Name, Funcs), foreign_resource(Name, Funcs)). +foreign_term(foreign(Func, Pred), foreign(Func, c, Pred)). +foreign_term(foreign(Func, Lang, Pred), foreign(Func, Lang, Pred)). + +state_module(module(M), M). +state_module(no_module, user). + +clean_resources(Module) :- + forall(foreign_term(_, T), Module:retractall(T)). diff --git a/library/dialect/sicstus/swipl-lfr.pl b/library/dialect/sicstus/swipl-lfr.pl deleted file mode 100755 index 4dc1f0478b..0000000000 --- a/library/dialect/sicstus/swipl-lfr.pl +++ /dev/null @@ -1,130 +0,0 @@ -#!/usr/bin/swipl - -:- set_prolog_flag(verbose, silent). -:- initialization main. - -/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -This file emulates SICStus the splfr program, which extracts -declarations for foreign resources from a Prolog file, creates a -wrapper, compiles this and finally generates a shared object that is -automatically loaded into SWI-Prolog. - -Note that this implementation is only partial. It was written for -running Alpino (www.let.rug.nl/vannoord/alp/Alpino/) and only processes -the commandline options needed for this. - -To use this facility, copy this file to a directory in your $PATH and -edit the first line to reflect the location of SWI-Prolog. -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ - -:- use_module(library(prolog_source)). -:- use_module(library(qpforeign)). -:- use_module(library(apply)). -:- use_module(library(debug)). -:- use_module(library(option)). - -:- debug(swipl_frl). - -main :- - current_prolog_flag(argv, Argv), - ( catch(swipl_frl(Argv), Error, - ( print_message(error, Error), - halt(1) - )) - -> halt - ; print_message(error, goal_failed(swipl_frl(Argv))), - halt(1) - ). - -swipl_frl(Av) :- - partition(longoption, Av, LongOptions, Av2), - maplist(longoption, LongOptions, NVList), - partition(plfile, Av2, PlFiles, Rest), - PlFiles = [PlFile], - file_name_extension(Base, _Ext, PlFile), - create_glue(PlFile, GlueFile), - option(cflag(CFlags), NVList, ''), - atomic_list_concat([GlueFile,CFlags|Rest], ' ', Cmd0), - format(atom(Cmd), 'swipl-ld -shared -o ~w ~w', [Base, Cmd0]), - debug(swipl_frl, '~w', [Cmd]), - shell(Cmd). - -plfile(Name) :- - \+ sub_atom(Name, 0, _, _, -), - file_name_extension(_, pl, Name). - -longoption(Name) :- - sub_atom(Name, 0, _, _, --). - -longoption(Option, Name=Value) :- - atom_concat(--, Rest, Option), - sub_atom(Rest, B, _, A, =), - sub_atom(Rest, 0, B, _, Name), - sub_atom(Rest, _, A, 0, Value). - -%% create_glue(+PrologFile, -GlueFile) is det -% -% Create the glue foreign resources in PrologFile. The glue is -% written to GlueFile. - -create_glue(File, Glue) :- - file_name_extension(Base, _Ext, File), - atom_concat(Base, '_swi_glue', GlueBase), - file_name_extension(GlueBase, c, Glue), - load_resource_decls(File, Module), - create_module_glue(Module, Base, GlueBase). - -create_module_glue(Module, Base, GlueBase) :- - Module:foreign_resource(Resource, _), - make_foreign_resource_wrapper(Module:Resource, Base, GlueBase). - - -%% load_resource_decls(+Source, -Module) -% -% Load SICSTus/Quintus resource declarations from Source. Module -% is the module in which the resources are loaded. - -load_resource_decls(Source, Module) :- - expects_dialect(sicstus), - prolog_canonical_source(Source, Id), - setup_call_cleanup(prolog_open_source(Id, In), - process(In, no_module, Module), - prolog_close_source(In)). - - -process(In, State0, Module) :- - prolog_read_source_term(In, _, Expanded, []), - process_terms(Expanded, State0, State1), - ( State1 = end_of_file(EndState) - -> state_module(EndState, Module) - ; process(In, State1, Module) - ). - -process_terms([], State, State) :- !. -process_terms([H|T], State0, State) :- !, - process_term(H, State0, State1), - ( State1 == end_of_file - -> State = State1 - ; process_terms(T, State1, State) - ). -process_terms(T, State0, State) :- - process_term(T, State0, State). - -process_term(end_of_file, State, end_of_file(State)) :- !. -process_term((:- module(Name, _)), _, module(Name)) :- !, - clean_resources(Name). -process_term(Term, State, State) :- - foreign_term(Term, Assert), !, - state_module(State, M), - assertz(M:Assert). -process_term(_, State, State). - -foreign_term(foreign_resource(Name, Funcs), foreign_resource(Name, Funcs)). -foreign_term(foreign(Func, Pred), foreign(Func, c, Pred)). -foreign_term(foreign(Func, Lang, Pred), foreign(Func, Lang, Pred)). - -state_module(module(M), M). -state_module(no_module, user). - -clean_resources(Module) :- - forall(foreign_term(_, T), Module:retractall(T)). diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index c1dc548cf0..4b10416e80 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -211,7 +211,7 @@ set(SWIPL_DATA_library_dialect_swi syspred_options.pl) set(SWIPL_DATA_library_dialect_eclipse test_util_iso.pl) set(SWIPL_DATA_library_dialect_hprolog format.pl) set(SWIPL_DATA_library_dialect_sicstus arrays.pl block.pl lists.pl ordsets.pl - README.TXT sockets.pl swipl-lfr.pl system.pl terms.pl timeout.pl) + README.TXT sockets.pl system.pl terms.pl timeout.pl) set(SWIPL_DATA_library_dialect_sicstus4 aggregate.pl between.pl clpfd.pl file_systems.pl lists.pl ordsets.pl samsort.pl sets.pl sockets.pl system.pl terms.pl timeout.pl types.pl) @@ -229,7 +229,7 @@ endif() set(SWIPL_DATA_demo likes.pl README.md) set(SWIPL_DATA_cmake swipl.cmake) -set(SWIPL_DATA_app pack.pl app.pl qlf.pl README.md) +set(SWIPL_DATA_app pack.pl app.pl qlf.pl splfr.pl README.md) ################ # Custom targets and commands diff --git a/src/compat/sicstus.h b/src/compat/sicstus.h index b8cd810eb0..25d820a37f 100644 --- a/src/compat/sicstus.h +++ b/src/compat/sicstus.h @@ -3,7 +3,8 @@ Author: Jan Wielemaker E-mail: J.Wielemaker@vu.nl WWW: http://www.swi-prolog.org - Copyright (c) 2010-2011, VU University Amsterdam + Copyright (c) 2010-2024, VU University Amsterdam + SWI-Prolog Solutions b.v. All rights reserved. Redistribution and use in source and binary forms, with or without @@ -281,7 +282,9 @@ SP_cons_functor_array(SP_term_ref term, SP_atom name, int arity, { int i; for(i=0; i