This commit is contained in:
Vítor Santos Costa 2008-12-22 12:02:22 +00:00
parent e51a4c2f5b
commit 60b899ee4d
27 changed files with 18468 additions and 0 deletions

807
LGPL/PLStream/ATOMS Normal file
View File

@ -0,0 +1,807 @@
# Definition table of atoms functors used somewhere in the C-code.
# format:
#
# A <name> <string>: --> #define ATOM_<name> into <string>
# F <name> <arity> --> #define FUNCTOR_<name><arity>
# (A name should exist as well)
#
# This file is processed using the Unix awk program defineatoms to produce
# pl-atom.ic, pl-atom.ih, pl-funct.ic and pl-funct.ih. If you do not have
# awk you can propagate the changes by hand, but be careful!
A abort "abort"
A aborted "$aborted"
A abs "abs"
A access "access"
A acos "acos"
A agc "agc"
A agc_gained "agc_gained"
A agc_margin "agc_margin"
A agc_time "agc_time"
A alias "alias"
A allow_variable_name_as_functor "allow_variable_name_as_functor"
A alnum "alnum"
A alpha "alpha"
A alternative "alternative"
A and "/\\"
A anonvar "_"
A append "append"
A ar_equals "=:="
A ar_not_equal "=\\="
A argument "argument"
A argumentlimit "argumentlimit"
A ascii "ascii"
A asin "asin"
A assert "assert"
A asserta "asserta"
A at "at"
A at_equals "=@="
A at_exit "at_exit"
A at_larger "@>"
A at_larger_eq "@>="
A at_not_equals "\\=@="
A at_smaller "@<"
A at_smaller_eq "@=<"
A atan "atan"
A atom "atom"
A atom_garbage_collection "atom_garbage_collection"
A atomic "atomic"
A atoms "atoms"
A att "att"
A attributes "attributes"
A attvar "attvar"
A autoload "autoload"
A backquoted_string "backquoted_string"
A backslash "\\"
A backtrace "backtrace"
A bar "|"
A begin "begin"
A binary "binary"
A bind "bind"
A block "block"
A bof "bof"
A bom "bom"
A bool "bool"
A brace_term_position "brace_term_position"
A break "break"
A btree "btree"
A buffer "buffer"
A buffer_size "buffer_size"
A built_in_procedure "built_in_procedure"
A busy "busy"
A byte "byte"
A call "call"
A callable "callable"
A callpred "$callpred"
A canceled "canceled"
A case_sensitive_file_names "case_sensitive_file_names"
A catch "catch"
A ceil "ceil"
A ceiling "ceiling"
A char_type "char_type"
A character "character"
A character_code "character_code"
A character_escapes "character_escapes"
A chars "chars"
A chdir "chdir"
A chmod "chmod"
A choice "choice"
A clause "clause"
A clause_reference "clause_reference"
A close "close"
A close_on_abort "close_on_abort"
A close_option "close_option"
A cm "cm"
A cntrl "cntrl"
A co "co"
A codes "codes"
A collected "collected"
A collections "collections"
A colon ":"
A comma ","
A comments "comments"
A compound "compound"
A context "context"
A context_module "context_module"
A continue "continue"
A core "core"
A core_left "core_left"
A cos "cos"
A cputime "cputime"
A create "create"
A csym "csym"
A csymf "csymf"
A cumulative "cumulative"
A curl "{}"
A current "current"
A current_input "current_input"
A current_output "current_output"
A cut "!"
A cut_call "cut_call"
A cut_exit "cut_exit"
A cut_parent "cut_parent"
A cutted "cut"
A date "date"
A dc_call_prolog "$c_call_prolog"
A db_reference "db_reference"
A dcall "<meta-call>"
A dcall_cleanup "$call_cleanup"
A dcatch "$catch"
A dcut "$cut"
A dde_error "dde_error"
A dde_handle "dde_handle"
A debug "debug"
A debug_on_error "debug_on_error"
A debugger_print_options "debugger_print_options"
A debugger_show_context "debugger_show_context"
A debugging "debugging"
A dec10 "dec10"
A default "default"
A defined "defined"
A delete "delete"
A depth_limit_exceeded "depth_limit_exceeded"
A destroy "destroy"
A detached "detached"
A detect "detect"
A development "development"
A dexit "$exit"
A dforeign_registered "$foreign_registered"
A dgarbage_collect "$garbage_collect"
A digit "digit"
A directory "directory"
A discontiguous "discontiguous"
A div "//"
A divide "/"
A dload "$load"
A dmessage_queue "$message_queue"
A dmutex "$mutex"
A domain_error "domain_error"
A dos "dos"
A dot "."
A dots "dots"
A double_quotes "double_quotes"
A doublestar "**"
A dprof_node "$profile_node"
A dstream "$stream"
A dthread_init "$thread_init"
A dthrow "$throw"
A dtime "$time"
A dwakeup "$wakeup"
A dynamic "dynamic"
A e "e"
A encoding "encoding"
A end "end"
A end_of_file "end_of_file"
A end_of_line "end_of_line"
A end_of_stream "end_of_stream"
A environment "environment"
A eof "eof"
A eof_action "eof_action"
A eof_code "eof_code"
A equal "equal"
A equals "="
A erase "erase"
A erased "erased"
A error "error"
A eval "eval"
A evaluable "evaluable"
A evaluation_error "evaluation_error"
A exception "exception"
A exclusive "exclusive"
A execute "execute"
A exist "exist"
A existence_error "existence_error"
A exit "exit"
A exited "exited"
A exp "exp"
A export "export"
A exported "exported"
A expression "expression"
A externals "externals"
A fact "fact"
A factor "factor"
A fail "fail"
A failure_error "failure_error"
A false "false"
A feature "feature"
A file "file"
A file_name "file_name"
A file_name_variables "file_name_variables"
A file_no "file_no"
A flag "flag"
A flag_value "flag_value"
A float "float"
A float_format "float_format"
A float_fractional_part "float_fractional_part"
A float_integer_part "float_integer_part"
A float_overflow "float_overflow"
A float_underflow "float_underflow"
A floor "floor"
A force "force"
A foreign "foreign"
A foreign_function "$foreign_function"
A foreign_return_value "foreign_return_value"
A fork "fork"
A frame "frame"
A frame_attribute "frame_attribute"
A frame_finished "frame_finished"
A frame_reference "frame_reference"
A free_of_attvar "free_of_attvar"
A freeze "freeze"
A full "full"
A functor_name "functor_name"
A functors "functors"
A fx "fx"
A fy "fy"
A garbage_collected "<garbage_collected>"
A garbage_collection "garbage_collection"
A gc "gc"
A gctime "gctime"
A getcwd "getcwd"
A global "global"
A global_shifts "global_shifts"
A global_stack "global_stack"
A globallimit "globallimit"
A globalused "globalused"
A goal "goal"
A goal_expansion "goal_expansion"
A grammar "-->"
A graph "graph"
A gvar "gvar"
A halt "halt"
A has_alternatives "has_alternatives"
A hash "hash"
A hashed "hashed"
A hat "^"
A heap "heap"
A heaplimit "heaplimit"
A heapused "heapused"
A help "help"
A hidden "hidden"
A hide_childs "hide_childs"
A history_depth "history_depth"
A ifthen "->"
A ignore "ignore"
A ignore_ops "ignore_ops"
A imported "imported"
A imported_procedure "imported_procedure"
A index "index"
A indexed "indexed"
A inf "inf"
A inferences "inferences"
A infinite "infinite"
A informational "informational"
A init_file "init_file"
A initialization "initialization"
A input "input"
A inserted_char "inserted_char"
A instantiation_error "instantiation_error"
A int "int"
A int64_t "int64_t"
A int_overflow "int_overflow"
A integer "integer"
A interrupt "interrupt"
A io_error "io_error"
A io_mode "io_mode"
A ioctl "ioctl"
A is "is"
A iso "iso"
A iso_latin_1 "iso_latin_1"
A isovar "$VAR"
A join "join"
A jump "jump"
A kernel "kernel"
A key "key"
A larger ">"
A larger_equal ">="
A level "level"
A li "li"
A limit "limit"
A line "line"
A line_count "line_count"
A list "list"
A list_position "list_position"
A listing "listing"
A local "local"
A local_shifts "local_shifts"
A local_stack "local_stack"
A locale "locale"
A locallimit "locallimit"
A localused "localused"
A lock "lock"
A locked "locked"
A log "log"
A log10 "log10"
A long "long"
A low "low"
A lower "lower"
A lsb "lsb"
A lshift "<<"
A main "main"
A mark "mark"
A matches "matches"
A max "max"
A max_arity "max_arity"
A max_dde_handles "max_dde_handles"
A max_depth "max_depth"
A max_files "max_files"
A max_path_length "max_path_length"
A max_size "max_size"
A max_variable_length "max_variable_length"
A memory "memory"
A message "message"
A message_lines "message_lines"
A message_queue "message_queue"
A message_queue_property "message_queue_property"
A meta_predicate "meta_predicate"
A min "min"
A min_free "min_free"
A minus "-"
A mismatched_char "mismatched_char"
A mod "mod"
A mode "mode"
A modify "modify"
A module "module"
A module_property "module_property"
A module_transparent "module_transparent"
A modules "modules"
A msb "msb"
A multifile "multifile"
A mutex "mutex"
A mutex_option "mutex_option"
A mutex_property "mutex_property"
A natural "natural"
A newline "newline"
A nil "[]"
A no_memory "no_memory"
A nodebug "nodebug"
A non_empty_list "non_empty_list"
A none "none"
A noprofile "noprofile"
A not "not"
A not_equals "\\="
A not_implemented "not_implemented"
A not_less_than_one "not_less_than_one"
A not_less_than_zero "not_less_than_zero"
A not_provable "\\+"
A not_strickt_equals "\\=="
A not_unique "not_unique"
A number "number"
A number_of_clauses "number_of_clauses"
A numbervar_option "numbervar_option"
A numbervars "numbervars"
A occurs_check "occurs_check"
A octet "octet"
A off "off"
A on "on"
A open "open"
A operator "operator"
A operator_priority "operator_priority"
A operator_specifier "operator_specifier"
A optimise "optimise"
A or "\\/"
A order "order"
A output "output"
A pair "pair"
A paren "paren"
A parent "parent"
A parent_goal "parent_goal"
A past "past"
A past_end_of_stream "past_end_of_stream"
A pattern "pattern"
A pc "pc"
A period "period"
A permission_error "permission_error"
A pi "pi"
A pipe "pipe"
A plain "plain"
A plus "+"
A popcount "popcount"
A portray "portray"
A position "position"
A posix "posix"
A powm "powm"
A predicate_indicator "predicate_indicator"
A predicates "predicates"
A print "print"
A print_message "print_message"
A priority "priority"
A private_procedure "private_procedure"
A procedure "procedure"
A profile_mode "profile_mode"
A profile_no_cpu_time "profile_no_cpu_time"
A profile_node "profile_node"
A program "program"
A program_counter "program_counter"
A prolog "prolog"
A prompt "|:"
A property "property"
A protocol "protocol"
A prove ":-"
A punct "punct"
A query "?-"
A queue_option "queue_option"
A quiet "quiet"
A quote "quote"
A quoted "quoted"
A radix "radix"
A random "random"
A rational "rational"
A rationalize "rationalize"
A rdiv "rdiv"
A read "read"
A read_option "read_option"
A readline "readline"
A real_time "real_time"
A receiver "receiver"
A record "record"
A record_position "record_position"
A redefine "redefine"
A redo "redo"
A references "references"
A rem "rem"
A rename "rename"
A report_error "report_error"
A reposition "reposition"
A representation_error "representation_error"
A representation_errors "representation_errors"
A reset "reset"
A resource_error "resource_error"
A resource_handle "resource_handle"
A retry "retry"
A round "round"
A rshift ">>"
A running "running"
A runtime "runtime"
A save_class "save_class"
A save_option "save_option"
A seek_method "seek_method"
A select "select"
A semicolon ";"
A separated "separated"
A setup_and_call_cleanup "setup_and_call_cleanup"
A shared "shared"
A shared_object "shared_object"
A shared_object_handle "shared_object_handle"
A shell "shell"
A sign "sign"
A signal "signal"
A signal_handler "signal_handler"
A silent "silent"
A sin "sin"
A singletons "singletons"
A size "size"
A skip "skip"
A smaller "<"
A smaller_equal "=<"
A softcut "*->"
A source_sink "source_sink"
A space "space"
A spy "spy"
A sqrt "sqrt"
A stack "stack"
A stack_parameter "stack_parameter"
A stack_shifts "stack_shifts"
A stacks "stacks"
A stand_alone "stand_alone"
A star "*"
A start "start"
A stat "stat"
A static_procedure "static_procedure"
A statistics "statistics"
A status "status"
A stderr "stderr"
A stream "stream"
A stream_option "stream_option"
A stream_or_alias "stream_or_alias"
A stream_position "$stream_position"
A stream_property "stream_property"
A strict_equal "=="
A string "string"
A string_position "string_position"
A subterm_positions "subterm_positions"
A suffix "suffix"
A syntax_error "syntax_error"
A syntax_errors "syntax_errors"
A system "system"
A system_error "system_error"
A system_init_file "system_init_file"
A system_thread_id "system_thread_id"
A system_time "system_time"
A tan "tan"
A term "term"
A term_expansion "term_expansion"
A term_position "term_position"
A terminal "terminal"
A terminal_capability "terminal_capability"
A text "text"
A thread "thread"
A thread_cputime "thread_cputime"
A thread_initialization "thread_initialization"
A thread_local "thread_local"
A thread_local_procedure "thread_local_procedure"
A thread_option "thread_option"
A thread_property "thread_property"
A threads "threads"
A threads_created "threads_created"
A throw "throw"
A tilde "~"
A time "time"
A time_stamp "time_stamp"
A timeout "timeout"
A timeout_error "timeout_error"
A timezone "timezone"
A to_lower "to_lower"
A to_upper "to_upper"
A top "top"
A top_level "top_level"
A toplevel "toplevel"
A trace "trace"
A trace_any "trace_any"
A trace_call "trace_call"
A trace_exit "trace_exit"
A trace_fail "trace_fail"
A trace_gc "trace_gc"
A trace_redo "trace_redo"
A traceinterc "prolog_trace_interception"
A tracing "tracing"
A trail "trail"
A trail_shifts "trail_shifts"
A traillimit "traillimit"
A trailused "trailused"
A transparent "transparent"
A transposed_char "transposed_char"
A transposed_word "transposed_word"
A true "true"
A truncate "truncate"
A tty "tty"
A tty_control "tty_control"
A type "type"
A type_error "type_error"
A undefined "undefined"
A undefined_global_variable "undefined_global_variable"
A undefinterc "$undefined_procedure"
A unicode_be "unicode_be"
A unicode_le "unicode_le"
A unify "unify"
A unique "unique"
A univ "=.."
A unknown "unknown"
A unlimited "unlimited"
A unlock "unlock"
A unlocked "unlocked"
A update "update"
A upper "upper"
A user "user"
A user_error "user_error"
A user_input "user_input"
A user_output "user_output"
A utc "UTC"
A utf8 "utf8"
A v "v"
A var "$VAR$"
A variable "variable"
A variable_names "variable_names"
A variables "variables"
A very_deep "very_deep"
A vmi "vmi"
A volatile "volatile"
A wakeup "wakeup"
A warning "warning"
A wchar_t "wchar_t"
A white "white"
A write "write"
A write_attributes "write_attributes"
A write_option "write_option"
A xdigit "xdigit"
A xf "xf"
A xfx "xfx"
A xfy "xfy"
A xml "xml"
A xor "xor"
A xpceref "@"
A yf "yf"
A yfx "yfx"
A yfy "yfy"
A zero_divisor "zero_divisor"
F abs 1
F access 1
F acos 1
F alias 1
F and 2
F ar_equals 2
F ar_not_equal 2
F asin 1
F assert 1
F asserta 1
F atan 1
F atan 2
F atom 1
F att 3
F backslash 1
F bar 2
F block 3
F bom 1
F brace_term_position 3
F break 1
F break 3
F buffer 1
F buffer_size 1
F busy 2
F call 1
F callpred 2
F catch 3
F ceil 1
F ceiling 1
F chars 1
F chars 2
F clause 1
F close_on_abort 1
F codes 1
F codes 2
F colon 2
F comma 2
F context 2
F cos 1
F cputime 0
F curl 1
F cut_call 1
F cut_exit 1
F date 9
F dcall 1
F dcut 1
F dde_error 2
F debugging 1
F detached 1
F dexit 2
F dforeign_registered 2
F dgarbage_collect 1
F div 2
F divide 2
F dmessage_queue 1
F dmutex 1
F domain_error 2
F dot 2
F doublestar 2
F dprof_node 1
F dstream 1
F dthread_init 0
F dthrow 1
F dtime 2
F dwakeup 1
F e 0
F encoding 1
F end_of_stream 1
F eof_action 1
F equals 2
F erased 1
F error 2
F eval 1
F evaluation_error 1
F exception 1
F exception 3
F existence_error 2
F exited 1
F exp 1
F fail 0
F failure_error 1
F file 1
F file 4
F file_name 1
F file_no 1
F float 1
F float_fractional_part 1
F float_integer_part 1
F floor 1
F foreign_function 1
F frame 3
F frame_finished 1
F goal_expansion 2
F hat 2
F ifthen 2
F input 0
F integer 1
F interrupt 1
F io_error 2
F is 2
F isovar 1
F larger 2
F larger_equal 2
F line_count 1
F list_position 4
F listing 1
F locked 2
F log 1
F log10 1
F lsb 1
F lshift 2
F max 2
F max_size 1
F message_lines 1
F min 2
F minus 1
F minus 2
F mod 2
F mode 1
F msb 1
F newline 1
F not_implemented 2
F not_provable 1
F occurs_check 2
F or 2
F output 0
F permission_error 3
F pi 0
F pipe 1
F plus 1
F plus 2
F popcount 1
F portray 1
F position 1
F powm 3
F print 1
F print_message 2
F procedure 2
F prove 1
F prove 2
F punct 2
F random 1
F rational 1
F rationalize 1
F rdiv 2
F rem 2
F reposition 1
F representation_error 1
F representation_errors 1
F resource_error 1
F retry 1
F round 1
F rshift 2
F semicolon 2
F setup_and_call_cleanup 4
F shared_object 2
F shell 2
F sign 1
F signal 1
F signal 2
F sin 1
F singletons 1
F size 1
F smaller 2
F smaller_equal 2
F softcut 2
F spy 1
F sqrt 1
F star 2
F status 1
F stream 4
F stream_position 4
F string 1
F string 2
F string_position 2
F syntax_error 1
F syntax_error 3
F tan 1
F term_expansion 2
F term_position 5
F timeout 1
F timeout_error 2
F trace 1
F traceinterc 3
F tracing 1
F true 0
F truncate 1
F tty 1
F type 1
F type_error 2
F undefinterc 4
F var 1
F wakeup 3
F warning 3
F xor 2
F xpceref 1
F dc_call_prolog 0
F strict_equal 2

119
LGPL/PLStream/Makefile.in Normal file
View File

@ -0,0 +1,119 @@
#
# default base directory for YAP installation
# (EROOT for architecture-dependent files)
#
GCC=@GCC@
prefix = @prefix@
ROOTDIR = $(prefix)
EROOTDIR = @exec_prefix@
#
# where the binary should be
#
BINDIR = $(EROOTDIR)/bin
#
# where YAP should look for libraries
#
LIBDIR=$(EROOTDIR)/lib/Yap
#
#
CC=@CC@
CFLAGS= @CFLAGS@ $(YAP_EXTRAS) $(DEFS) -I$(srcdir) -I../.. -I$(srcdir)/../../include
#
#
# You shouldn't need to change what follows.
#
INSTALL=@INSTALL@
INSTALL_DATA=@INSTALL_DATA@
INSTALL_PROGRAM=@INSTALL_PROGRAM@
SHELL=/bin/sh
RANLIB=@RANLIB@
srcdir=@srcdir@
SHLIB_CFLAGS=@SHLIB_CFLAGS@
SHLIB_SUFFIX=@SHLIB_SUFFIX@
#4.1VPATH=@srcdir@:@srcdir@/OPTYap
CWD=$(PWD)
#
HEADERS=$(srcdir)/atoms.h $(srcdir)/pl-buffer.h $(srcdir)/pl-ctype.h \
$(srcdir)/pl-incl.h $(srcdir)/pl-opts.h \
$(srcdir)/pl-os.h \
$(srcdir)/pl-stream.h \
$(srcdir)/pl-table.h \
$(srcdir)/pl-text.h $(srcdir)/pl-utf8.h \
$(srcdir)/pl-yap.h
C_SOURCES=$(srcdir)/pl-buffer.c $(srcdir)/pl-ctype.c \
$(srcdir)/pl-error.c $(srcdir)/pl-feature.c \
$(srcdir)/pl-file.c $(srcdir)/pl-os.c \
$(srcdir)/pl-stream.c $(srcdir)/pl-string.c \
$(srcdir)/pl-table.c \
$(srcdir)/pl-text.c $(srcdir)/pl-utf8.c \
$(srcdir)/pl-yap.c
OBJS=pl-buffer.o pl-ctype.o pl-error.o pl-feature.o \
pl-file.o pl-os.o \
pl-stream.o pl-string.o pl-table.o pl-text.o pl-utf8.o \
pl-yap.o
SOBJS=plstream@SHLIB_SUFFIX@
#in some systems we just create a single object, in others we need to
# create a libray
all: $(SOBJS)
pl-buffer.o: $(srcdir)/pl-buffer.c
$(CC) -c $(CFLAGS) $(SHLIB_CFLAGS) $(srcdir)/pl-buffer.c -o pl-buffer.o
pl-ctype.o: $(srcdir)/pl-ctype.c
$(CC) -c $(CFLAGS) $(SHLIB_CFLAGS) $(srcdir)/pl-ctype.c -o pl-ctype.o
pl-error.o: $(srcdir)/pl-error.c
$(CC) -c $(CFLAGS) $(SHLIB_CFLAGS) $(srcdir)/pl-error.c -o pl-error.o
pl-feature.o: $(srcdir)/pl-feature.c
$(CC) -c $(CFLAGS) $(SHLIB_CFLAGS) $(srcdir)/pl-feature.c -o pl-feature.o
pl-file.o: $(srcdir)/pl-file.c
$(CC) -c $(CFLAGS) $(SHLIB_CFLAGS) $(srcdir)/pl-file.c -o pl-file.o
pl-os.o: $(srcdir)/pl-os.c
$(CC) -c $(CFLAGS) $(SHLIB_CFLAGS) $(srcdir)/pl-os.c -o pl-os.o
pl-stream.o: $(srcdir)/pl-stream.c
$(CC) -c $(CFLAGS) $(SHLIB_CFLAGS) $(srcdir)/pl-stream.c -o pl-stream.o
pl-string.o: $(srcdir)/pl-string.c
$(CC) -c $(CFLAGS) $(SHLIB_CFLAGS) $(srcdir)/pl-string.c -o pl-string.o
pl-table.o: $(srcdir)/pl-table.c
$(CC) -c $(CFLAGS) $(SHLIB_CFLAGS) $(srcdir)/pl-table.c -o pl-table.o
pl-text.o: $(srcdir)/pl-text.c
$(CC) -c $(CFLAGS) $(SHLIB_CFLAGS) $(srcdir)/pl-text.c -o pl-text.o
pl-utf8.o: $(srcdir)/pl-utf8.c
$(CC) -c $(CFLAGS) $(SHLIB_CFLAGS) $(srcdir)/pl-utf8.c -o pl-utf8.o
pl-yap.o: $(srcdir)/pl-yap.c
$(CC) -c $(CFLAGS) $(SHLIB_CFLAGS) $(srcdir)/pl-yap.c -o pl-yap.o
@DO_SECOND_LD@%@SHLIB_SUFFIX@: %.o
@DO_SECOND_LD@ @SHLIB_LD@ -o $@ $<
@DO_SECOND_LD@plstream@SHLIB_SUFFIX@: $(OBJS)
@DO_SECOND_LD@ @SHLIB_LD@ -o plstream@SHLIB_SUFFIX@ $(OBJS)
install: all
$(INSTALL_PROGRAM) $(SOBJS) $(DESTDIR)$(LIBDIR)
clean:
rm -f *.o *~ $(OBJS) $(SOBJS) *.BAK
depend: $(HEADERS) $(C_SOURCES)
-@if test "$(GCC)" = yes; then\
$(CC) -MM -MG $(CFLAGS) -I$(srcdir) -I$(srcdir)/../../include -I$(srcdir)/../../H $(C_SOURCES) > depend;\
else\
makedepend -f - -- $(CFLAGS) -I$(srcdir)/../../H -I$(srcdir)/../../include -- $(C_SOURCES) |\
sed 's|.*/\([^:]*\):|\1:|' > .depend ;\
fi
include depend

793
LGPL/PLStream/atoms.h Normal file
View File

@ -0,0 +1,793 @@
#define ATOM_abort MK_ATOM("abort")
#define ATOM_aborted MK_ATOM("$aborted")
#define ATOM_abs MK_ATOM("abs")
#define ATOM_access MK_ATOM("access")
#define ATOM_acos MK_ATOM("acos")
#define ATOM_agc MK_ATOM("agc")
#define ATOM_agc_gained MK_ATOM("agc_gained")
#define ATOM_agc_margin MK_ATOM("agc_margin")
#define ATOM_agc_time MK_ATOM("agc_time")
#define ATOM_alias MK_ATOM("alias")
#define ATOM_allow_variable_name_as_functor MK_ATOM("allow_variable_name_as_functor")
#define ATOM_alnum MK_ATOM("alnum")
#define ATOM_alpha MK_ATOM("alpha")
#define ATOM_alternative MK_ATOM("alternative")
#define ATOM_and MK_ATOM("/\\")
#define ATOM_anonvar MK_ATOM("_")
#define ATOM_append MK_ATOM("append")
#define ATOM_ar_equals MK_ATOM("=:=")
#define ATOM_ar_not_equal MK_ATOM("=\\=")
#define ATOM_argument MK_ATOM("argument")
#define ATOM_argumentlimit MK_ATOM("argumentlimit")
#define ATOM_ascii MK_ATOM("ascii")
#define ATOM_asin MK_ATOM("asin")
#define ATOM_assert MK_ATOM("assert")
#define ATOM_asserta MK_ATOM("asserta")
#define ATOM_at MK_ATOM("at")
#define ATOM_at_equals MK_ATOM("=@=")
#define ATOM_at_exit MK_ATOM("at_exit")
#define ATOM_at_larger MK_ATOM("@>")
#define ATOM_at_larger_eq MK_ATOM("@>=")
#define ATOM_at_not_equals MK_ATOM("\\=@=")
#define ATOM_at_smaller MK_ATOM("@<")
#define ATOM_at_smaller_eq MK_ATOM("@=<")
#define ATOM_atan MK_ATOM("atan")
#define ATOM_atom MK_ATOM("atom")
#define ATOM_atom_garbage_collection MK_ATOM("atom_garbage_collection")
#define ATOM_atomic MK_ATOM("atomic")
#define ATOM_atoms MK_ATOM("atoms")
#define ATOM_att MK_ATOM("att")
#define ATOM_attributes MK_ATOM("attributes")
#define ATOM_attvar MK_ATOM("attvar")
#define ATOM_autoload MK_ATOM("autoload")
#define ATOM_backquoted_string MK_ATOM("backquoted_string")
#define ATOM_backslash MK_ATOM("\\")
#define ATOM_backtrace MK_ATOM("backtrace")
#define ATOM_bar MK_ATOM("|")
#define ATOM_begin MK_ATOM("begin")
#define ATOM_binary MK_ATOM("binary")
#define ATOM_bind MK_ATOM("bind")
#define ATOM_block MK_ATOM("block")
#define ATOM_bof MK_ATOM("bof")
#define ATOM_bom MK_ATOM("bom")
#define ATOM_bool MK_ATOM("bool")
#define ATOM_brace_term_position MK_ATOM("brace_term_position")
#define ATOM_break MK_ATOM("break")
#define ATOM_btree MK_ATOM("btree")
#define ATOM_buffer MK_ATOM("buffer")
#define ATOM_buffer_size MK_ATOM("buffer_size")
#define ATOM_built_in_procedure MK_ATOM("built_in_procedure")
#define ATOM_busy MK_ATOM("busy")
#define ATOM_byte MK_ATOM("byte")
#define ATOM_call MK_ATOM("call")
#define ATOM_callable MK_ATOM("callable")
#define ATOM_callpred MK_ATOM("$callpred")
#define ATOM_canceled MK_ATOM("canceled")
#define ATOM_case_sensitive_file_names MK_ATOM("case_sensitive_file_names")
#define ATOM_catch MK_ATOM("catch")
#define ATOM_ceil MK_ATOM("ceil")
#define ATOM_ceiling MK_ATOM("ceiling")
#define ATOM_char_type MK_ATOM("char_type")
#define ATOM_character MK_ATOM("character")
#define ATOM_character_code MK_ATOM("character_code")
#define ATOM_character_escapes MK_ATOM("character_escapes")
#define ATOM_chars MK_ATOM("chars")
#define ATOM_chdir MK_ATOM("chdir")
#define ATOM_chmod MK_ATOM("chmod")
#define ATOM_choice MK_ATOM("choice")
#define ATOM_clause MK_ATOM("clause")
#define ATOM_clause_reference MK_ATOM("clause_reference")
#define ATOM_close MK_ATOM("close")
#define ATOM_close_on_abort MK_ATOM("close_on_abort")
#define ATOM_close_option MK_ATOM("close_option")
#define ATOM_cm MK_ATOM("cm")
#define ATOM_cntrl MK_ATOM("cntrl")
#define ATOM_co MK_ATOM("co")
#define ATOM_codes MK_ATOM("codes")
#define ATOM_collected MK_ATOM("collected")
#define ATOM_collections MK_ATOM("collections")
#define ATOM_colon MK_ATOM(":")
#define ATOM_comma MK_ATOM(",")
#define ATOM_comments MK_ATOM("comments")
#define ATOM_compound MK_ATOM("compound")
#define ATOM_context MK_ATOM("context")
#define ATOM_context_module MK_ATOM("context_module")
#define ATOM_continue MK_ATOM("continue")
#define ATOM_core MK_ATOM("core")
#define ATOM_core_left MK_ATOM("core_left")
#define ATOM_cos MK_ATOM("cos")
#define ATOM_cputime MK_ATOM("cputime")
#define ATOM_create MK_ATOM("create")
#define ATOM_csym MK_ATOM("csym")
#define ATOM_csymf MK_ATOM("csymf")
#define ATOM_cumulative MK_ATOM("cumulative")
#define ATOM_curl MK_ATOM("{}")
#define ATOM_current MK_ATOM("current")
#define ATOM_current_input MK_ATOM("current_input")
#define ATOM_current_output MK_ATOM("current_output")
#define ATOM_cut MK_ATOM("!")
#define ATOM_cut_call MK_ATOM("cut_call")
#define ATOM_cut_exit MK_ATOM("cut_exit")
#define ATOM_cut_parent MK_ATOM("cut_parent")
#define ATOM_cutted MK_ATOM("cut")
#define ATOM_date MK_ATOM("date")
#define ATOM_dc_call_prolog MK_ATOM("$c_call_prolog")
#define ATOM_db_reference MK_ATOM("db_reference")
#define ATOM_dcall MK_ATOM("<meta-call>")
#define ATOM_dcall_cleanup MK_ATOM("$call_cleanup")
#define ATOM_dcatch MK_ATOM("$catch")
#define ATOM_dcut MK_ATOM("$cut")
#define ATOM_dde_error MK_ATOM("dde_error")
#define ATOM_dde_handle MK_ATOM("dde_handle")
#define ATOM_debug MK_ATOM("debug")
#define ATOM_debug_on_error MK_ATOM("debug_on_error")
#define ATOM_debugger_print_options MK_ATOM("debugger_print_options")
#define ATOM_debugger_show_context MK_ATOM("debugger_show_context")
#define ATOM_debugging MK_ATOM("debugging")
#define ATOM_dec10 MK_ATOM("dec10")
#define ATOM_default MK_ATOM("default")
#define ATOM_defined MK_ATOM("defined")
#define ATOM_delete MK_ATOM("delete")
#define ATOM_depth_limit_exceeded MK_ATOM("depth_limit_exceeded")
#define ATOM_destroy MK_ATOM("destroy")
#define ATOM_detached MK_ATOM("detached")
#define ATOM_detect MK_ATOM("detect")
#define ATOM_development MK_ATOM("development")
#define ATOM_dexit MK_ATOM("$exit")
#define ATOM_dforeign_registered MK_ATOM("$foreign_registered")
#define ATOM_dgarbage_collect MK_ATOM("$garbage_collect")
#define ATOM_digit MK_ATOM("digit")
#define ATOM_directory MK_ATOM("directory")
#define ATOM_discontiguous MK_ATOM("discontiguous")
#define ATOM_div MK_ATOM("//")
#define ATOM_divide MK_ATOM("/")
#define ATOM_dload MK_ATOM("$load")
#define ATOM_dmessage_queue MK_ATOM("$message_queue")
#define ATOM_dmutex MK_ATOM("$mutex")
#define ATOM_domain_error MK_ATOM("domain_error")
#define ATOM_dos MK_ATOM("dos")
#define ATOM_dot MK_ATOM(".")
#define ATOM_dots MK_ATOM("dots")
#define ATOM_double_quotes MK_ATOM("double_quotes")
#define ATOM_doublestar MK_ATOM("**")
#define ATOM_dprof_node MK_ATOM("$profile_node")
#define ATOM_dstream MK_ATOM("$stream")
#define ATOM_dthread_init MK_ATOM("$thread_init")
#define ATOM_dthrow MK_ATOM("$throw")
#define ATOM_dtime MK_ATOM("$time")
#define ATOM_dwakeup MK_ATOM("$wakeup")
#define ATOM_dynamic MK_ATOM("dynamic")
#define ATOM_e MK_ATOM("e")
#define ATOM_encoding MK_ATOM("encoding")
#define ATOM_end MK_ATOM("end")
#define ATOM_end_of_file MK_ATOM("end_of_file")
#define ATOM_end_of_line MK_ATOM("end_of_line")
#define ATOM_end_of_stream MK_ATOM("end_of_stream")
#define ATOM_environment MK_ATOM("environment")
#define ATOM_eof MK_ATOM("eof")
#define ATOM_eof_action MK_ATOM("eof_action")
#define ATOM_eof_code MK_ATOM("eof_code")
#define ATOM_equal MK_ATOM("equal")
#define ATOM_equals MK_ATOM("=")
#define ATOM_erase MK_ATOM("erase")
#define ATOM_erased MK_ATOM("erased")
#define ATOM_error MK_ATOM("error")
#define ATOM_eval MK_ATOM("eval")
#define ATOM_evaluable MK_ATOM("evaluable")
#define ATOM_evaluation_error MK_ATOM("evaluation_error")
#define ATOM_exception MK_ATOM("exception")
#define ATOM_exclusive MK_ATOM("exclusive")
#define ATOM_execute MK_ATOM("execute")
#define ATOM_exist MK_ATOM("exist")
#define ATOM_existence_error MK_ATOM("existence_error")
#define ATOM_exit MK_ATOM("exit")
#define ATOM_exited MK_ATOM("exited")
#define ATOM_exp MK_ATOM("exp")
#define ATOM_export MK_ATOM("export")
#define ATOM_exported MK_ATOM("exported")
#define ATOM_expression MK_ATOM("expression")
#define ATOM_externals MK_ATOM("externals")
#define ATOM_fact MK_ATOM("fact")
#define ATOM_factor MK_ATOM("factor")
#define ATOM_fail MK_ATOM("fail")
#define ATOM_failure_error MK_ATOM("failure_error")
#define ATOM_false MK_ATOM("false")
#define ATOM_feature MK_ATOM("feature")
#define ATOM_file MK_ATOM("file")
#define ATOM_file_name MK_ATOM("file_name")
#define ATOM_file_name_variables MK_ATOM("file_name_variables")
#define ATOM_file_no MK_ATOM("file_no")
#define ATOM_flag MK_ATOM("flag")
#define ATOM_flag_value MK_ATOM("flag_value")
#define ATOM_float MK_ATOM("float")
#define ATOM_float_format MK_ATOM("float_format")
#define ATOM_float_fractional_part MK_ATOM("float_fractional_part")
#define ATOM_float_integer_part MK_ATOM("float_integer_part")
#define ATOM_float_overflow MK_ATOM("float_overflow")
#define ATOM_float_underflow MK_ATOM("float_underflow")
#define ATOM_floor MK_ATOM("floor")
#define ATOM_force MK_ATOM("force")
#define ATOM_foreign MK_ATOM("foreign")
#define ATOM_foreign_function MK_ATOM("$foreign_function")
#define ATOM_foreign_return_value MK_ATOM("foreign_return_value")
#define ATOM_fork MK_ATOM("fork")
#define ATOM_frame MK_ATOM("frame")
#define ATOM_frame_attribute MK_ATOM("frame_attribute")
#define ATOM_frame_finished MK_ATOM("frame_finished")
#define ATOM_frame_reference MK_ATOM("frame_reference")
#define ATOM_free_of_attvar MK_ATOM("free_of_attvar")
#define ATOM_freeze MK_ATOM("freeze")
#define ATOM_full MK_ATOM("full")
#define ATOM_functor_name MK_ATOM("functor_name")
#define ATOM_functors MK_ATOM("functors")
#define ATOM_fx MK_ATOM("fx")
#define ATOM_fy MK_ATOM("fy")
#define ATOM_garbage_collected MK_ATOM("<garbage_collected>")
#define ATOM_garbage_collection MK_ATOM("garbage_collection")
#define ATOM_gc MK_ATOM("gc")
#define ATOM_gctime MK_ATOM("gctime")
#define ATOM_getcwd MK_ATOM("getcwd")
#define ATOM_global MK_ATOM("global")
#define ATOM_global_shifts MK_ATOM("global_shifts")
#define ATOM_global_stack MK_ATOM("global_stack")
#define ATOM_globallimit MK_ATOM("globallimit")
#define ATOM_globalused MK_ATOM("globalused")
#define ATOM_goal MK_ATOM("goal")
#define ATOM_goal_expansion MK_ATOM("goal_expansion")
#define ATOM_grammar MK_ATOM("-->")
#define ATOM_graph MK_ATOM("graph")
#define ATOM_gvar MK_ATOM("gvar")
#define ATOM_halt MK_ATOM("halt")
#define ATOM_has_alternatives MK_ATOM("has_alternatives")
#define ATOM_hash MK_ATOM("hash")
#define ATOM_hashed MK_ATOM("hashed")
#define ATOM_hat MK_ATOM("^")
#define ATOM_heap MK_ATOM("heap")
#define ATOM_heaplimit MK_ATOM("heaplimit")
#define ATOM_heapused MK_ATOM("heapused")
#define ATOM_help MK_ATOM("help")
#define ATOM_hidden MK_ATOM("hidden")
#define ATOM_hide_childs MK_ATOM("hide_childs")
#define ATOM_history_depth MK_ATOM("history_depth")
#define ATOM_ifthen MK_ATOM("->")
#define ATOM_ignore MK_ATOM("ignore")
#define ATOM_ignore_ops MK_ATOM("ignore_ops")
#define ATOM_imported MK_ATOM("imported")
#define ATOM_imported_procedure MK_ATOM("imported_procedure")
#define ATOM_index MK_ATOM("index")
#define ATOM_indexed MK_ATOM("indexed")
#define ATOM_inf MK_ATOM("inf")
#define ATOM_inferences MK_ATOM("inferences")
#define ATOM_infinite MK_ATOM("infinite")
#define ATOM_informational MK_ATOM("informational")
#define ATOM_init_file MK_ATOM("init_file")
#define ATOM_initialization MK_ATOM("initialization")
#define ATOM_input MK_ATOM("input")
#define ATOM_inserted_char MK_ATOM("inserted_char")
#define ATOM_instantiation_error MK_ATOM("instantiation_error")
#define ATOM_int MK_ATOM("int")
#define ATOM_int64_t MK_ATOM("int64_t")
#define ATOM_int_overflow MK_ATOM("int_overflow")
#define ATOM_integer MK_ATOM("integer")
#define ATOM_interrupt MK_ATOM("interrupt")
#define ATOM_io_error MK_ATOM("io_error")
#define ATOM_io_mode MK_ATOM("io_mode")
#define ATOM_ioctl MK_ATOM("ioctl")
#define ATOM_is MK_ATOM("is")
#define ATOM_iso MK_ATOM("iso")
#define ATOM_iso_latin_1 MK_ATOM("iso_latin_1")
#define ATOM_isovar MK_ATOM("$VAR")
#define ATOM_join MK_ATOM("join")
#define ATOM_jump MK_ATOM("jump")
#define ATOM_kernel MK_ATOM("kernel")
#define ATOM_key MK_ATOM("key")
#define ATOM_larger MK_ATOM(">")
#define ATOM_larger_equal MK_ATOM(">=")
#define ATOM_level MK_ATOM("level")
#define ATOM_li MK_ATOM("li")
#define ATOM_limit MK_ATOM("limit")
#define ATOM_line MK_ATOM("line")
#define ATOM_line_count MK_ATOM("line_count")
#define ATOM_list MK_ATOM("list")
#define ATOM_list_position MK_ATOM("list_position")
#define ATOM_listing MK_ATOM("listing")
#define ATOM_local MK_ATOM("local")
#define ATOM_local_shifts MK_ATOM("local_shifts")
#define ATOM_local_stack MK_ATOM("local_stack")
#define ATOM_locale MK_ATOM("locale")
#define ATOM_locallimit MK_ATOM("locallimit")
#define ATOM_localused MK_ATOM("localused")
#define ATOM_lock MK_ATOM("lock")
#define ATOM_locked MK_ATOM("locked")
#define ATOM_log MK_ATOM("log")
#define ATOM_log10 MK_ATOM("log10")
#define ATOM_long MK_ATOM("long")
#define ATOM_low MK_ATOM("low")
#define ATOM_lower MK_ATOM("lower")
#define ATOM_lsb MK_ATOM("lsb")
#define ATOM_lshift MK_ATOM("<<")
#define ATOM_main MK_ATOM("main")
#define ATOM_mark MK_ATOM("mark")
#define ATOM_matches MK_ATOM("matches")
#define ATOM_max MK_ATOM("max")
#define ATOM_max_arity MK_ATOM("max_arity")
#define ATOM_max_dde_handles MK_ATOM("max_dde_handles")
#define ATOM_max_depth MK_ATOM("max_depth")
#define ATOM_max_files MK_ATOM("max_files")
#define ATOM_max_path_length MK_ATOM("max_path_length")
#define ATOM_max_size MK_ATOM("max_size")
#define ATOM_max_variable_length MK_ATOM("max_variable_length")
#define ATOM_memory MK_ATOM("memory")
#define ATOM_message MK_ATOM("message")
#define ATOM_message_lines MK_ATOM("message_lines")
#define ATOM_message_queue MK_ATOM("message_queue")
#define ATOM_message_queue_property MK_ATOM("message_queue_property")
#define ATOM_meta_predicate MK_ATOM("meta_predicate")
#define ATOM_min MK_ATOM("min")
#define ATOM_min_free MK_ATOM("min_free")
#define ATOM_minus MK_ATOM("-")
#define ATOM_mismatched_char MK_ATOM("mismatched_char")
#define ATOM_mod MK_ATOM("mod")
#define ATOM_mode MK_ATOM("mode")
#define ATOM_modify MK_ATOM("modify")
#define ATOM_module MK_ATOM("module")
#define ATOM_module_property MK_ATOM("module_property")
#define ATOM_module_transparent MK_ATOM("module_transparent")
#define ATOM_modules MK_ATOM("modules")
#define ATOM_msb MK_ATOM("msb")
#define ATOM_multifile MK_ATOM("multifile")
#define ATOM_mutex MK_ATOM("mutex")
#define ATOM_mutex_option MK_ATOM("mutex_option")
#define ATOM_mutex_property MK_ATOM("mutex_property")
#define ATOM_natural MK_ATOM("natural")
#define ATOM_newline MK_ATOM("newline")
#define ATOM_nil MK_ATOM("[]")
#define ATOM_no_memory MK_ATOM("no_memory")
#define ATOM_nodebug MK_ATOM("nodebug")
#define ATOM_non_empty_list MK_ATOM("non_empty_list")
#define ATOM_none MK_ATOM("none")
#define ATOM_noprofile MK_ATOM("noprofile")
#define ATOM_not MK_ATOM("not")
#define ATOM_not_equals MK_ATOM("\\=")
#define ATOM_not_implemented MK_ATOM("not_implemented")
#define ATOM_not_less_than_one MK_ATOM("not_less_than_one")
#define ATOM_not_less_than_zero MK_ATOM("not_less_than_zero")
#define ATOM_not_provable MK_ATOM("\\+")
#define ATOM_not_strickt_equals MK_ATOM("\\==")
#define ATOM_not_unique MK_ATOM("not_unique")
#define ATOM_number MK_ATOM("number")
#define ATOM_number_of_clauses MK_ATOM("number_of_clauses")
#define ATOM_numbervar_option MK_ATOM("numbervar_option")
#define ATOM_numbervars MK_ATOM("numbervars")
#define ATOM_occurs_check MK_ATOM("occurs_check")
#define ATOM_octet MK_ATOM("octet")
#define ATOM_off MK_ATOM("off")
#define ATOM_on MK_ATOM("on")
#define ATOM_open MK_ATOM("open")
#define ATOM_operator MK_ATOM("operator")
#define ATOM_operator_priority MK_ATOM("operator_priority")
#define ATOM_operator_specifier MK_ATOM("operator_specifier")
#define ATOM_optimise MK_ATOM("optimise")
#define ATOM_or MK_ATOM("\\/")
#define ATOM_order MK_ATOM("order")
#define ATOM_output MK_ATOM("output")
#define ATOM_pair MK_ATOM("pair")
#define ATOM_paren MK_ATOM("paren")
#define ATOM_parent MK_ATOM("parent")
#define ATOM_parent_goal MK_ATOM("parent_goal")
#define ATOM_past MK_ATOM("past")
#define ATOM_past_end_of_stream MK_ATOM("past_end_of_stream")
#define ATOM_pattern MK_ATOM("pattern")
#define ATOM_pc MK_ATOM("pc")
#define ATOM_period MK_ATOM("period")
#define ATOM_permission_error MK_ATOM("permission_error")
#define ATOM_pi MK_ATOM("pi")
#define ATOM_pipe MK_ATOM("pipe")
#define ATOM_plain MK_ATOM("plain")
#define ATOM_plus MK_ATOM("+")
#define ATOM_popcount MK_ATOM("popcount")
#define ATOM_portray MK_ATOM("portray")
#define ATOM_position MK_ATOM("position")
#define ATOM_posix MK_ATOM("posix")
#define ATOM_powm MK_ATOM("powm")
#define ATOM_predicate_indicator MK_ATOM("predicate_indicator")
#define ATOM_predicates MK_ATOM("predicates")
#define ATOM_print MK_ATOM("print")
#define ATOM_print_message MK_ATOM("print_message")
#define ATOM_priority MK_ATOM("priority")
#define ATOM_private_procedure MK_ATOM("private_procedure")
#define ATOM_procedure MK_ATOM("procedure")
#define ATOM_profile_mode MK_ATOM("profile_mode")
#define ATOM_profile_no_cpu_time MK_ATOM("profile_no_cpu_time")
#define ATOM_profile_node MK_ATOM("profile_node")
#define ATOM_program MK_ATOM("program")
#define ATOM_program_counter MK_ATOM("program_counter")
#define ATOM_prolog MK_ATOM("prolog")
#define ATOM_prompt MK_ATOM("|:")
#define ATOM_property MK_ATOM("property")
#define ATOM_protocol MK_ATOM("protocol")
#define ATOM_prove MK_ATOM(":-")
#define ATOM_punct MK_ATOM("punct")
#define ATOM_query MK_ATOM("?-")
#define ATOM_queue_option MK_ATOM("queue_option")
#define ATOM_quiet MK_ATOM("quiet")
#define ATOM_quote MK_ATOM("quote")
#define ATOM_quoted MK_ATOM("quoted")
#define ATOM_radix MK_ATOM("radix")
#define ATOM_random MK_ATOM("random")
#define ATOM_rational MK_ATOM("rational")
#define ATOM_rationalize MK_ATOM("rationalize")
#define ATOM_rdiv MK_ATOM("rdiv")
#define ATOM_read MK_ATOM("read")
#define ATOM_read_option MK_ATOM("read_option")
#define ATOM_readline MK_ATOM("readline")
#define ATOM_real_time MK_ATOM("real_time")
#define ATOM_receiver MK_ATOM("receiver")
#define ATOM_record MK_ATOM("record")
#define ATOM_record_position MK_ATOM("record_position")
#define ATOM_redefine MK_ATOM("redefine")
#define ATOM_redo MK_ATOM("redo")
#define ATOM_references MK_ATOM("references")
#define ATOM_rem MK_ATOM("rem")
#define ATOM_rename MK_ATOM("rename")
#define ATOM_report_error MK_ATOM("report_error")
#define ATOM_reposition MK_ATOM("reposition")
#define ATOM_representation_error MK_ATOM("representation_error")
#define ATOM_representation_errors MK_ATOM("representation_errors")
#define ATOM_reset MK_ATOM("reset")
#define ATOM_resource_error MK_ATOM("resource_error")
#define ATOM_resource_handle MK_ATOM("resource_handle")
#define ATOM_retry MK_ATOM("retry")
#define ATOM_round MK_ATOM("round")
#define ATOM_rshift MK_ATOM(">>")
#define ATOM_running MK_ATOM("running")
#define ATOM_runtime MK_ATOM("runtime")
#define ATOM_save_class MK_ATOM("save_class")
#define ATOM_save_option MK_ATOM("save_option")
#define ATOM_seek_method MK_ATOM("seek_method")
#define ATOM_select MK_ATOM("select")
#define ATOM_semicolon MK_ATOM(";")
#define ATOM_separated MK_ATOM("separated")
#define ATOM_setup_and_call_cleanup MK_ATOM("setup_and_call_cleanup")
#define ATOM_shared MK_ATOM("shared")
#define ATOM_shared_object MK_ATOM("shared_object")
#define ATOM_shared_object_handle MK_ATOM("shared_object_handle")
#define ATOM_shell MK_ATOM("shell")
#define ATOM_sign MK_ATOM("sign")
#define ATOM_signal MK_ATOM("signal")
#define ATOM_signal_handler MK_ATOM("signal_handler")
#define ATOM_silent MK_ATOM("silent")
#define ATOM_sin MK_ATOM("sin")
#define ATOM_singletons MK_ATOM("singletons")
#define ATOM_size MK_ATOM("size")
#define ATOM_skip MK_ATOM("skip")
#define ATOM_smaller MK_ATOM("<")
#define ATOM_smaller_equal MK_ATOM("=<")
#define ATOM_softcut MK_ATOM("*->")
#define ATOM_source_sink MK_ATOM("source_sink")
#define ATOM_space MK_ATOM("space")
#define ATOM_spy MK_ATOM("spy")
#define ATOM_sqrt MK_ATOM("sqrt")
#define ATOM_stack MK_ATOM("stack")
#define ATOM_stack_parameter MK_ATOM("stack_parameter")
#define ATOM_stack_shifts MK_ATOM("stack_shifts")
#define ATOM_stacks MK_ATOM("stacks")
#define ATOM_stand_alone MK_ATOM("stand_alone")
#define ATOM_star MK_ATOM("*")
#define ATOM_start MK_ATOM("start")
#define ATOM_stat MK_ATOM("stat")
#define ATOM_static_procedure MK_ATOM("static_procedure")
#define ATOM_statistics MK_ATOM("statistics")
#define ATOM_status MK_ATOM("status")
#define ATOM_stderr MK_ATOM("stderr")
#define ATOM_stream MK_ATOM("stream")
#define ATOM_stream_option MK_ATOM("stream_option")
#define ATOM_stream_or_alias MK_ATOM("stream_or_alias")
#define ATOM_stream_position MK_ATOM("$stream_position")
#define ATOM_stream_property MK_ATOM("stream_property")
#define ATOM_strict_equal MK_ATOM("==")
#define ATOM_string MK_ATOM("string")
#define ATOM_string_position MK_ATOM("string_position")
#define ATOM_subterm_positions MK_ATOM("subterm_positions")
#define ATOM_suffix MK_ATOM("suffix")
#define ATOM_syntax_error MK_ATOM("syntax_error")
#define ATOM_syntax_errors MK_ATOM("syntax_errors")
#define ATOM_system MK_ATOM("system")
#define ATOM_system_error MK_ATOM("system_error")
#define ATOM_system_init_file MK_ATOM("system_init_file")
#define ATOM_system_thread_id MK_ATOM("system_thread_id")
#define ATOM_system_time MK_ATOM("system_time")
#define ATOM_tan MK_ATOM("tan")
#define ATOM_term MK_ATOM("term")
#define ATOM_term_expansion MK_ATOM("term_expansion")
#define ATOM_term_position MK_ATOM("term_position")
#define ATOM_terminal MK_ATOM("terminal")
#define ATOM_terminal_capability MK_ATOM("terminal_capability")
#define ATOM_text MK_ATOM("text")
#define ATOM_thread MK_ATOM("thread")
#define ATOM_thread_cputime MK_ATOM("thread_cputime")
#define ATOM_thread_initialization MK_ATOM("thread_initialization")
#define ATOM_thread_local MK_ATOM("thread_local")
#define ATOM_thread_local_procedure MK_ATOM("thread_local_procedure")
#define ATOM_thread_option MK_ATOM("thread_option")
#define ATOM_thread_property MK_ATOM("thread_property")
#define ATOM_threads MK_ATOM("threads")
#define ATOM_threads_created MK_ATOM("threads_created")
#define ATOM_throw MK_ATOM("throw")
#define ATOM_tilde MK_ATOM("~")
#define ATOM_time MK_ATOM("time")
#define ATOM_time_stamp MK_ATOM("time_stamp")
#define ATOM_timeout MK_ATOM("timeout")
#define ATOM_timeout_error MK_ATOM("timeout_error")
#define ATOM_timezone MK_ATOM("timezone")
#define ATOM_to_lower MK_ATOM("to_lower")
#define ATOM_to_upper MK_ATOM("to_upper")
#define ATOM_top MK_ATOM("top")
#define ATOM_top_level MK_ATOM("top_level")
#define ATOM_toplevel MK_ATOM("toplevel")
#define ATOM_trace MK_ATOM("trace")
#define ATOM_trace_any MK_ATOM("trace_any")
#define ATOM_trace_call MK_ATOM("trace_call")
#define ATOM_trace_exit MK_ATOM("trace_exit")
#define ATOM_trace_fail MK_ATOM("trace_fail")
#define ATOM_trace_gc MK_ATOM("trace_gc")
#define ATOM_trace_redo MK_ATOM("trace_redo")
#define ATOM_traceinterc MK_ATOM("prolog_trace_interception")
#define ATOM_tracing MK_ATOM("tracing")
#define ATOM_trail MK_ATOM("trail")
#define ATOM_trail_shifts MK_ATOM("trail_shifts")
#define ATOM_traillimit MK_ATOM("traillimit")
#define ATOM_trailused MK_ATOM("trailused")
#define ATOM_transparent MK_ATOM("transparent")
#define ATOM_transposed_char MK_ATOM("transposed_char")
#define ATOM_transposed_word MK_ATOM("transposed_word")
#define ATOM_true MK_ATOM("true")
#define ATOM_truncate MK_ATOM("truncate")
#define ATOM_tty MK_ATOM("tty")
#define ATOM_tty_control MK_ATOM("tty_control")
#define ATOM_type MK_ATOM("type")
#define ATOM_type_error MK_ATOM("type_error")
#define ATOM_undefined MK_ATOM("undefined")
#define ATOM_undefined_global_variable MK_ATOM("undefined_global_variable")
#define ATOM_undefinterc MK_ATOM("$undefined_procedure")
#define ATOM_unicode_be MK_ATOM("unicode_be")
#define ATOM_unicode_le MK_ATOM("unicode_le")
#define ATOM_unify MK_ATOM("unify")
#define ATOM_unique MK_ATOM("unique")
#define ATOM_univ MK_ATOM("=..")
#define ATOM_unknown MK_ATOM("unknown")
#define ATOM_unlimited MK_ATOM("unlimited")
#define ATOM_unlock MK_ATOM("unlock")
#define ATOM_unlocked MK_ATOM("unlocked")
#define ATOM_update MK_ATOM("update")
#define ATOM_upper MK_ATOM("upper")
#define ATOM_user MK_ATOM("user")
#define ATOM_user_error MK_ATOM("user_error")
#define ATOM_user_input MK_ATOM("user_input")
#define ATOM_user_output MK_ATOM("user_output")
#define ATOM_utc MK_ATOM("UTC")
#define ATOM_utf8 MK_ATOM("utf8")
#define ATOM_v MK_ATOM("v")
#define ATOM_var MK_ATOM("$VAR$")
#define ATOM_variable MK_ATOM("variable")
#define ATOM_variable_names MK_ATOM("variable_names")
#define ATOM_variables MK_ATOM("variables")
#define ATOM_very_deep MK_ATOM("very_deep")
#define ATOM_vmi MK_ATOM("vmi")
#define ATOM_volatile MK_ATOM("volatile")
#define ATOM_wakeup MK_ATOM("wakeup")
#define ATOM_warning MK_ATOM("warning")
#define ATOM_wchar_t MK_ATOM("wchar_t")
#define ATOM_white MK_ATOM("white")
#define ATOM_write MK_ATOM("write")
#define ATOM_write_attributes MK_ATOM("write_attributes")
#define ATOM_write_option MK_ATOM("write_option")
#define ATOM_xdigit MK_ATOM("xdigit")
#define ATOM_xf MK_ATOM("xf")
#define ATOM_xfx MK_ATOM("xfx")
#define ATOM_xfy MK_ATOM("xfy")
#define ATOM_xml MK_ATOM("xml")
#define ATOM_xor MK_ATOM("xor")
#define ATOM_xpceref MK_ATOM("@")
#define ATOM_yf MK_ATOM("yf")
#define ATOM_yfx MK_ATOM("yfx")
#define ATOM_yfy MK_ATOM("yfy")
#define ATOM_zero_divisor MK_ATOM("zero_divisor")
#define FUNCTOR_abs1 MKFUNCTOR(ATOM_abs,1)
#define FUNCTOR_access1 MKFUNCTOR(ATOM_access,1)
#define FUNCTOR_acos1 MKFUNCTOR(ATOM_acos,1)
#define FUNCTOR_alias1 MKFUNCTOR(ATOM_alias,1)
#define FUNCTOR_and2 MKFUNCTOR(ATOM_and,2)
#define FUNCTOR_ar_equals2 MKFUNCTOR(ATOM_ar_equals,2)
#define FUNCTOR_ar_not_equal2 MKFUNCTOR(ATOM_ar_not_equal,2)
#define FUNCTOR_asin1 MKFUNCTOR(ATOM_asin,1)
#define FUNCTOR_assert1 MKFUNCTOR(ATOM_assert,1)
#define FUNCTOR_asserta1 MKFUNCTOR(ATOM_asserta,1)
#define FUNCTOR_atan1 MKFUNCTOR(ATOM_atan,1)
#define FUNCTOR_atan2 MKFUNCTOR(ATOM_atan,2)
#define FUNCTOR_atom1 MKFUNCTOR(ATOM_atom,1)
#define FUNCTOR_att3 MKFUNCTOR(ATOM_att,3)
#define FUNCTOR_backslash1 MKFUNCTOR(ATOM_backslash,1)
#define FUNCTOR_bar2 MKFUNCTOR(ATOM_bar,2)
#define FUNCTOR_block3 MKFUNCTOR(ATOM_block,3)
#define FUNCTOR_bom1 MKFUNCTOR(ATOM_bom,1)
#define FUNCTOR_brace_term_position3 MKFUNCTOR(ATOM_brace_term_position,3)
#define FUNCTOR_break1 MKFUNCTOR(ATOM_break,1)
#define FUNCTOR_break3 MKFUNCTOR(ATOM_break,3)
#define FUNCTOR_buffer1 MKFUNCTOR(ATOM_buffer,1)
#define FUNCTOR_buffer_size1 MKFUNCTOR(ATOM_buffer_size,1)
#define FUNCTOR_busy2 MKFUNCTOR(ATOM_busy,2)
#define FUNCTOR_call1 MKFUNCTOR(ATOM_call,1)
#define FUNCTOR_callpred2 MKFUNCTOR(ATOM_callpred,2)
#define FUNCTOR_catch3 MKFUNCTOR(ATOM_catch,3)
#define FUNCTOR_ceil1 MKFUNCTOR(ATOM_ceil,1)
#define FUNCTOR_ceiling1 MKFUNCTOR(ATOM_ceiling,1)
#define FUNCTOR_chars1 MKFUNCTOR(ATOM_chars,1)
#define FUNCTOR_chars2 MKFUNCTOR(ATOM_chars,2)
#define FUNCTOR_clause1 MKFUNCTOR(ATOM_clause,1)
#define FUNCTOR_close_on_abort1 MKFUNCTOR(ATOM_close_on_abort,1)
#define FUNCTOR_codes1 MKFUNCTOR(ATOM_codes,1)
#define FUNCTOR_codes2 MKFUNCTOR(ATOM_codes,2)
#define FUNCTOR_colon2 MKFUNCTOR(ATOM_colon,2)
#define FUNCTOR_comma2 MKFUNCTOR(ATOM_comma,2)
#define FUNCTOR_context2 MKFUNCTOR(ATOM_context,2)
#define FUNCTOR_cos1 MKFUNCTOR(ATOM_cos,1)
#define FUNCTOR_cputime0 MKFUNCTOR(ATOM_cputime,0)
#define FUNCTOR_curl1 MKFUNCTOR(ATOM_curl,1)
#define FUNCTOR_cut_call1 MKFUNCTOR(ATOM_cut_call,1)
#define FUNCTOR_cut_exit1 MKFUNCTOR(ATOM_cut_exit,1)
#define FUNCTOR_date9 MKFUNCTOR(ATOM_date,9)
#define FUNCTOR_dcall1 MKFUNCTOR(ATOM_dcall,1)
#define FUNCTOR_dcut1 MKFUNCTOR(ATOM_dcut,1)
#define FUNCTOR_dde_error2 MKFUNCTOR(ATOM_dde_error,2)
#define FUNCTOR_debugging1 MKFUNCTOR(ATOM_debugging,1)
#define FUNCTOR_detached1 MKFUNCTOR(ATOM_detached,1)
#define FUNCTOR_dexit2 MKFUNCTOR(ATOM_dexit,2)
#define FUNCTOR_dforeign_registered2 MKFUNCTOR(ATOM_dforeign_registered,2)
#define FUNCTOR_dgarbage_collect1 MKFUNCTOR(ATOM_dgarbage_collect,1)
#define FUNCTOR_div2 MKFUNCTOR(ATOM_div,2)
#define FUNCTOR_divide2 MKFUNCTOR(ATOM_divide,2)
#define FUNCTOR_dmessage_queue1 MKFUNCTOR(ATOM_dmessage_queue,1)
#define FUNCTOR_dmutex1 MKFUNCTOR(ATOM_dmutex,1)
#define FUNCTOR_domain_error2 MKFUNCTOR(ATOM_domain_error,2)
#define FUNCTOR_dot2 MKFUNCTOR(ATOM_dot,2)
#define FUNCTOR_doublestar2 MKFUNCTOR(ATOM_doublestar,2)
#define FUNCTOR_dprof_node1 MKFUNCTOR(ATOM_dprof_node,1)
#define FUNCTOR_dstream1 MKFUNCTOR(ATOM_dstream,1)
#define FUNCTOR_dthread_init0 MKFUNCTOR(ATOM_dthread_init,0)
#define FUNCTOR_dthrow1 MKFUNCTOR(ATOM_dthrow,1)
#define FUNCTOR_dtime2 MKFUNCTOR(ATOM_dtime,2)
#define FUNCTOR_dwakeup1 MKFUNCTOR(ATOM_dwakeup,1)
#define FUNCTOR_e0 MKFUNCTOR(ATOM_e,0)
#define FUNCTOR_encoding1 MKFUNCTOR(ATOM_encoding,1)
#define FUNCTOR_end_of_stream1 MKFUNCTOR(ATOM_end_of_stream,1)
#define FUNCTOR_eof_action1 MKFUNCTOR(ATOM_eof_action,1)
#define FUNCTOR_equals2 MKFUNCTOR(ATOM_equals,2)
#define FUNCTOR_erased1 MKFUNCTOR(ATOM_erased,1)
#define FUNCTOR_error2 MKFUNCTOR(ATOM_error,2)
#define FUNCTOR_eval1 MKFUNCTOR(ATOM_eval,1)
#define FUNCTOR_evaluation_error1 MKFUNCTOR(ATOM_evaluation_error,1)
#define FUNCTOR_exception1 MKFUNCTOR(ATOM_exception,1)
#define FUNCTOR_exception3 MKFUNCTOR(ATOM_exception,3)
#define FUNCTOR_existence_error2 MKFUNCTOR(ATOM_existence_error,2)
#define FUNCTOR_exited1 MKFUNCTOR(ATOM_exited,1)
#define FUNCTOR_exp1 MKFUNCTOR(ATOM_exp,1)
#define FUNCTOR_fail0 MKFUNCTOR(ATOM_fail,0)
#define FUNCTOR_failure_error1 MKFUNCTOR(ATOM_failure_error,1)
#define FUNCTOR_file1 MKFUNCTOR(ATOM_file,1)
#define FUNCTOR_file4 MKFUNCTOR(ATOM_file,4)
#define FUNCTOR_file_name1 MKFUNCTOR(ATOM_file_name,1)
#define FUNCTOR_file_no1 MKFUNCTOR(ATOM_file_no,1)
#define FUNCTOR_float1 MKFUNCTOR(ATOM_float,1)
#define FUNCTOR_float_fractional_part1 MKFUNCTOR(ATOM_float_fractional_part,1)
#define FUNCTOR_float_integer_part1 MKFUNCTOR(ATOM_float_integer_part,1)
#define FUNCTOR_floor1 MKFUNCTOR(ATOM_floor,1)
#define FUNCTOR_foreign_function1 MKFUNCTOR(ATOM_foreign_function,1)
#define FUNCTOR_frame3 MKFUNCTOR(ATOM_frame,3)
#define FUNCTOR_frame_finished1 MKFUNCTOR(ATOM_frame_finished,1)
#define FUNCTOR_goal_expansion2 MKFUNCTOR(ATOM_goal_expansion,2)
#define FUNCTOR_hat2 MKFUNCTOR(ATOM_hat,2)
#define FUNCTOR_ifthen2 MKFUNCTOR(ATOM_ifthen,2)
#define FUNCTOR_input0 MKFUNCTOR(ATOM_input,0)
#define FUNCTOR_integer1 MKFUNCTOR(ATOM_integer,1)
#define FUNCTOR_interrupt1 MKFUNCTOR(ATOM_interrupt,1)
#define FUNCTOR_io_error2 MKFUNCTOR(ATOM_io_error,2)
#define FUNCTOR_is2 MKFUNCTOR(ATOM_is,2)
#define FUNCTOR_isovar1 MKFUNCTOR(ATOM_isovar,1)
#define FUNCTOR_larger2 MKFUNCTOR(ATOM_larger,2)
#define FUNCTOR_larger_equal2 MKFUNCTOR(ATOM_larger_equal,2)
#define FUNCTOR_line_count1 MKFUNCTOR(ATOM_line_count,1)
#define FUNCTOR_list_position4 MKFUNCTOR(ATOM_list_position,4)
#define FUNCTOR_listing1 MKFUNCTOR(ATOM_listing,1)
#define FUNCTOR_locked2 MKFUNCTOR(ATOM_locked,2)
#define FUNCTOR_log1 MKFUNCTOR(ATOM_log,1)
#define FUNCTOR_log101 MKFUNCTOR(ATOM_log10,1)
#define FUNCTOR_lsb1 MKFUNCTOR(ATOM_lsb,1)
#define FUNCTOR_lshift2 MKFUNCTOR(ATOM_lshift,2)
#define FUNCTOR_max2 MKFUNCTOR(ATOM_max,2)
#define FUNCTOR_max_size1 MKFUNCTOR(ATOM_max_size,1)
#define FUNCTOR_message_lines1 MKFUNCTOR(ATOM_message_lines,1)
#define FUNCTOR_min2 MKFUNCTOR(ATOM_min,2)
#define FUNCTOR_minus1 MKFUNCTOR(ATOM_minus,1)
#define FUNCTOR_minus2 MKFUNCTOR(ATOM_minus,2)
#define FUNCTOR_mod2 MKFUNCTOR(ATOM_mod,2)
#define FUNCTOR_mode1 MKFUNCTOR(ATOM_mode,1)
#define FUNCTOR_msb1 MKFUNCTOR(ATOM_msb,1)
#define FUNCTOR_newline1 MKFUNCTOR(ATOM_newline,1)
#define FUNCTOR_not_implemented2 MKFUNCTOR(ATOM_not_implemented,2)
#define FUNCTOR_not_provable1 MKFUNCTOR(ATOM_not_provable,1)
#define FUNCTOR_occurs_check2 MKFUNCTOR(ATOM_occurs_check,2)
#define FUNCTOR_or2 MKFUNCTOR(ATOM_or,2)
#define FUNCTOR_output0 MKFUNCTOR(ATOM_output,0)
#define FUNCTOR_permission_error3 MKFUNCTOR(ATOM_permission_error,3)
#define FUNCTOR_pi0 MKFUNCTOR(ATOM_pi,0)
#define FUNCTOR_pipe1 MKFUNCTOR(ATOM_pipe,1)
#define FUNCTOR_plus1 MKFUNCTOR(ATOM_plus,1)
#define FUNCTOR_plus2 MKFUNCTOR(ATOM_plus,2)
#define FUNCTOR_popcount1 MKFUNCTOR(ATOM_popcount,1)
#define FUNCTOR_portray1 MKFUNCTOR(ATOM_portray,1)
#define FUNCTOR_position1 MKFUNCTOR(ATOM_position,1)
#define FUNCTOR_powm3 MKFUNCTOR(ATOM_powm,3)
#define FUNCTOR_print1 MKFUNCTOR(ATOM_print,1)
#define FUNCTOR_print_message2 MKFUNCTOR(ATOM_print_message,2)
#define FUNCTOR_procedure2 MKFUNCTOR(ATOM_procedure,2)
#define FUNCTOR_prove1 MKFUNCTOR(ATOM_prove,1)
#define FUNCTOR_prove2 MKFUNCTOR(ATOM_prove,2)
#define FUNCTOR_punct2 MKFUNCTOR(ATOM_punct,2)
#define FUNCTOR_random1 MKFUNCTOR(ATOM_random,1)
#define FUNCTOR_rational1 MKFUNCTOR(ATOM_rational,1)
#define FUNCTOR_rationalize1 MKFUNCTOR(ATOM_rationalize,1)
#define FUNCTOR_rdiv2 MKFUNCTOR(ATOM_rdiv,2)
#define FUNCTOR_rem2 MKFUNCTOR(ATOM_rem,2)
#define FUNCTOR_reposition1 MKFUNCTOR(ATOM_reposition,1)
#define FUNCTOR_representation_error1 MKFUNCTOR(ATOM_representation_error,1)
#define FUNCTOR_representation_errors1 MKFUNCTOR(ATOM_representation_errors,1)
#define FUNCTOR_resource_error1 MKFUNCTOR(ATOM_resource_error,1)
#define FUNCTOR_retry1 MKFUNCTOR(ATOM_retry,1)
#define FUNCTOR_round1 MKFUNCTOR(ATOM_round,1)
#define FUNCTOR_rshift2 MKFUNCTOR(ATOM_rshift,2)
#define FUNCTOR_semicolon2 MKFUNCTOR(ATOM_semicolon,2)
#define FUNCTOR_setup_and_call_cleanup4 MKFUNCTOR(ATOM_setup_and_call_cleanup,4)
#define FUNCTOR_shared_object2 MKFUNCTOR(ATOM_shared_object,2)
#define FUNCTOR_shell2 MKFUNCTOR(ATOM_shell,2)
#define FUNCTOR_sign1 MKFUNCTOR(ATOM_sign,1)
#define FUNCTOR_signal1 MKFUNCTOR(ATOM_signal,1)
#define FUNCTOR_signal2 MKFUNCTOR(ATOM_signal,2)
#define FUNCTOR_sin1 MKFUNCTOR(ATOM_sin,1)
#define FUNCTOR_singletons1 MKFUNCTOR(ATOM_singletons,1)
#define FUNCTOR_size1 MKFUNCTOR(ATOM_size,1)
#define FUNCTOR_smaller2 MKFUNCTOR(ATOM_smaller,2)
#define FUNCTOR_smaller_equal2 MKFUNCTOR(ATOM_smaller_equal,2)
#define FUNCTOR_softcut2 MKFUNCTOR(ATOM_softcut,2)
#define FUNCTOR_spy1 MKFUNCTOR(ATOM_spy,1)
#define FUNCTOR_sqrt1 MKFUNCTOR(ATOM_sqrt,1)
#define FUNCTOR_star2 MKFUNCTOR(ATOM_star,2)
#define FUNCTOR_status1 MKFUNCTOR(ATOM_status,1)
#define FUNCTOR_stream4 MKFUNCTOR(ATOM_stream,4)
#define FUNCTOR_stream_position4 MKFUNCTOR(ATOM_stream_position,4)
#define FUNCTOR_string1 MKFUNCTOR(ATOM_string,1)
#define FUNCTOR_string2 MKFUNCTOR(ATOM_string,2)
#define FUNCTOR_string_position2 MKFUNCTOR(ATOM_string_position,2)
#define FUNCTOR_syntax_error1 MKFUNCTOR(ATOM_syntax_error,1)
#define FUNCTOR_syntax_error3 MKFUNCTOR(ATOM_syntax_error,3)
#define FUNCTOR_tan1 MKFUNCTOR(ATOM_tan,1)
#define FUNCTOR_term_expansion2 MKFUNCTOR(ATOM_term_expansion,2)
#define FUNCTOR_term_position5 MKFUNCTOR(ATOM_term_position,5)
#define FUNCTOR_timeout1 MKFUNCTOR(ATOM_timeout,1)
#define FUNCTOR_timeout_error2 MKFUNCTOR(ATOM_timeout_error,2)
#define FUNCTOR_trace1 MKFUNCTOR(ATOM_trace,1)
#define FUNCTOR_traceinterc3 MKFUNCTOR(ATOM_traceinterc,3)
#define FUNCTOR_tracing1 MKFUNCTOR(ATOM_tracing,1)
#define FUNCTOR_true0 MKFUNCTOR(ATOM_true,0)
#define FUNCTOR_truncate1 MKFUNCTOR(ATOM_truncate,1)
#define FUNCTOR_tty1 MKFUNCTOR(ATOM_tty,1)
#define FUNCTOR_type1 MKFUNCTOR(ATOM_type,1)
#define FUNCTOR_type_error2 MKFUNCTOR(ATOM_type_error,2)
#define FUNCTOR_undefinterc4 MKFUNCTOR(ATOM_undefinterc,4)
#define FUNCTOR_var1 MKFUNCTOR(ATOM_var,1)
#define FUNCTOR_wakeup3 MKFUNCTOR(ATOM_wakeup,3)
#define FUNCTOR_warning3 MKFUNCTOR(ATOM_warning,3)
#define FUNCTOR_xor2 MKFUNCTOR(ATOM_xor,2)
#define FUNCTOR_xpceref1 MKFUNCTOR(ATOM_xpceref,1)
#define FUNCTOR_dc_call_prolog0 MKFUNCTOR(ATOM_dc_call_prolog,0)
#define FUNCTOR_strict_equal2 MKFUNCTOR(ATOM_strict_equal,2)

35
LGPL/PLStream/buildatoms Normal file
View File

@ -0,0 +1,35 @@
:- use_module(library(lineutils),
[file_filter/3,
split/3]).
:- use_module(library(lists),
[append/2]).
:- initialization(main).
:- yap_flag(write_strings,on).
main :-
file_filter('ATOMS','atoms.h',gen_decl).
gen_decl(Inp,Out) :-
split(Inp," ",["A",Atom,String]), !,
append(["#define ATOM_",Atom," MK_ATOM(",String,")"],Out).
gen_decl(Inp,Out) :-
split(Inp," ",["F",Name,Arity]), !,
counter(I),
number_codes(I,IS),
append(["#define FUNCTOR_",Name,Arity," MKFUNCTOR(ATOM_",Name,",",Arity,")"],Out).
:- nb_setval(count,0).
counter(I) :-
nb_getval(count,I),
I1 is I+1,
nb_setval(count,I1).

114
LGPL/PLStream/pl-buffer.c Normal file
View File

@ -0,0 +1,114 @@
/* $Id$
Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: jan@swi.psy.uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2002, University of Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#include "pl-incl.h"
// vsc: changed from SWI
#define discardable_buffer (LD->discardable_buffer)
#define buffer_ring (LD->buffer_ring)
#define current_buffer_id (LD->current_buffer_id)
Buffer
findBuffer(int flags)
{ GET_LD
Buffer b;
if ( flags & BUF_RING )
{ if ( ++current_buffer_id == BUFFER_RING_SIZE )
current_buffer_id = 0;
b = &buffer_ring[current_buffer_id];
} else
b = &discardable_buffer;
if ( !b->base )
initBuffer(b);
emptyBuffer(b);
return b;
}
int
unfindBuffer(int flags)
{ GET_LD
if ( flags & BUF_RING )
{ if ( --current_buffer_id <= 0 )
current_buffer_id = BUFFER_RING_SIZE-1;
}
fail;
}
void
growBuffer(Buffer b, size_t minfree)
{ size_t osz = b->max - b->base, sz = osz;
size_t top = b->top - b->base;
if ( b->max - b->top >= (int)minfree )
return;
if ( sz < 512 )
sz = 512; /* minimum reasonable size */
while( top + minfree > sz )
sz *= 2;
if ( b->base != b->static_buffer )
{
#ifdef BUFFER_USES_MALLOC
b->base = realloc(b->base, sz);
if ( !b->base )
outOfCore();
#else
char *old = b->base;
b->base = allocHeap(sz);
memcpy(b->base, old, osz);
#endif
} else /* from static buffer */
{ char *new;
#ifdef BUFFER_USES_MALLOC
if ( !(new = malloc(sz)) )
outOfCore();
#else
new = allocHeap(sz);
#endif
memcpy(new, b->static_buffer, osz);
b->base = new;
}
b->top = b->base + top;
b->max = b->base + sz;
}
char *
buffer_string(const char *s, int flags)
{ Buffer b = findBuffer(flags);
size_t l = strlen(s) + 1;
addMultipleBuffer(b, s, l, char);
return baseBuffer(b, char);
}

112
LGPL/PLStream/pl-buffer.h Normal file
View File

@ -0,0 +1,112 @@
/* $Id$
Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: jan@swi.psy.uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2002, University of Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#ifndef BUFFER_H_INCLUDED
#define BUFFER_H_INCLUDED
#define STATIC_BUFFER_SIZE (512)
#define BUFFER_USES_MALLOC 1
#define BUFFER_RING_SIZE 16 /* foreign buffer ring (pl-fli.c) */
typedef struct
{ char * base; /* allocated base */
char * top; /* pointer to top */
char * max; /* current location */
char static_buffer[STATIC_BUFFER_SIZE];
} tmp_buffer, *TmpBuffer;
typedef struct
{ char * base; /* allocated base */
char * top; /* pointer to top */
char * max; /* current location */
char static_buffer[sizeof(char *)];
} buffer, *Buffer;
void growBuffer(Buffer b, size_t minfree);
Buffer findBuffer(int flags);
char *buffer_string(const char *s, int flags);
int unfindBuffer(int flags);
Buffer codes_or_chars_to_buffer(term_t l, unsigned int flags, int wide);
#define addBuffer(b, obj, type) \
do \
{ if ( (b)->top + sizeof(type) > (b)->max ) \
growBuffer((Buffer)b, sizeof(type)); \
*((type *)(b)->top) = obj; \
(b)->top += sizeof(type); \
} while(0)
#define addMultipleBuffer(b, ptr, times, type) \
do \
{ size_t _tms = (times); \
size_t _len = _tms * sizeof(type); \
type *_d, *_s = (type *)ptr; \
if ( (b)->top + _len > (b)->max ) \
growBuffer((Buffer)b, _len); \
_d = (type *)(b)->top; \
while ( _tms-- ) \
*_d++ = *_s++; \
(b)->top = (char *)_d; \
} while(0)
#define baseBuffer(b, type) ((type *) (b)->base)
#define topBuffer(b, type) ((type *) (b)->top)
#define inBuffer(b, addr) ((char *) (addr) >= (b)->base && \
(char *) (addr) < (b)->top)
#define fetchBuffer(b, i, type) (baseBuffer(b, type)[i])
#define seekBuffer(b, cnt, type) ((b)->top = sizeof(type) * (cnt) + (b)->base)
#define sizeOfBuffer(b) ((b)->top - (b)->base)
#define freeSpaceBuffer(b) ((b)->max - (b)->top)
#define entriesBuffer(b, type) (sizeOfBuffer(b) / sizeof(type))
#define initBuffer(b) ((b)->base = (b)->top = (b)->static_buffer, \
(b)->max = (b)->base + \
sizeof((b)->static_buffer))
#define emptyBuffer(b) ((b)->top = (b)->base)
#define isEmptyBuffer(b) ((b)->top == (b)->base)
#ifdef BUFFER_USES_MALLOC
#define discardBuffer(b) \
do \
{ if ( (b)->base && (b)->base != (b)->static_buffer ) \
{ free((b)->base); \
(b)->base = (b)->static_buffer; \
} \
} while(0)
#else
#define discardBuffer(b) \
do \
{ if ( (b)->base && (b)->base != (b)->static_buffer ) \
{ freeHeap((b)->base, (b)->max - (b)->base); \
(b)->base = (b)->static_buffer; \
} \
} while(0)
#endif
#endif /*BUFFER_H_INCLUDED*/

911
LGPL/PLStream/pl-ctype.c Normal file
View File

@ -0,0 +1,911 @@
/* $Id$
Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: wielemak@science.uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2007, University of Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#include "pl-incl.h"
#include <ctype.h>
#include "pl-ctype.h"
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
This module defines:
char_type(?Char, ?Type)
code_type(?Char, ?Type)
See manual for details.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#define CHAR_MODE 0
#define CODE_MODE 1
#define CTX_CHAR 0 /* Class(Char) */
#define CTX_CODE 1 /* Class(Int) */
typedef struct
{ atom_t name; /* name of the class */
int (*test)(wint_t chr); /* boolean */
int (*reverse)(wint_t chr); /* reverse mapping */
short arity; /* arity of class (i.e. lower('A')) */
short ctx_type; /* CTX_* */
} char_type;
#define ENUM_NONE 0x00
#define ENUM_CHAR 0x01
#define ENUM_CLASS 0x02
#define ENUM_BOTH 0x03
typedef struct
{ int current; /* current character */
const char_type *class; /* current class */
int do_enum; /* what to enumerate */
} generator;
static int unicode_separator(pl_wchar_t c);
static int
iswhite(wint_t chr)
{ return chr == ' ' || chr == '\t';
}
#ifdef __YAP_PROLOG__
inline int
unicode_separator(pl_wchar_t c)
{ //return PlBlankW(c); // vsc: we need to look into this
return iswhite(c);
}
#endif
static int
fiscsym(wint_t chr)
{ return iswalnum(chr) || chr == '_';
}
static int
fiscsymf(wint_t chr)
{ return iswalpha(chr) || chr == '_';
}
static int
iseof(wint_t chr)
{ return chr == (wint_t)-1;
}
static int
iseol(wint_t chr)
{ return chr >= 10 && chr <= 13;
}
static int
isnl(wint_t chr)
{ return chr == '\n';
}
static int
isperiod(wint_t chr)
{ return chr && strchr(".?!", chr) != NULL;
}
static int
isquote(wint_t chr)
{ return chr && strchr("'`\"", chr) != NULL;
}
static int
fupper(wint_t chr)
{ return iswlower(chr) ? (int)towupper(chr) : -1;
}
static int
flower(wint_t chr)
{ return iswupper(chr) ? (int)towlower(chr) : -1;
}
static int
ftoupper(wint_t chr)
{ return towupper(chr);
}
static int
ftolower(wint_t chr)
{ return towlower(chr);
}
static int
fparen(wint_t chr)
{ switch(chr)
{ case '(':
return ')';
case '{':
return '}';
case '[':
return ']';
default:
return -1;
}
}
static int
rparen(wint_t chr)
{ switch(chr)
{ case ')':
return '(';
case '}':
return '{';
case ']':
return '[';
default:
return -1;
}
}
static int
fdigit(wint_t chr)
{ if ( chr <= 0xff && isdigit(chr) )
return chr - '0';
return -1;
}
static int
rdigit(wint_t d)
{ if ( (int)d >= 0 && d <= 9 )
return d+'0';
return -1;
}
static int
fxdigit(wint_t chr)
{ if ( chr > 0xff )
return -1;
if ( isdigit(chr) )
return chr - '0';
if ( chr >= 'a' && chr <= 'f' )
return chr - 'a' + 10;
if ( chr >= 'A' && chr <= 'F' )
return chr - 'A' + 10;
return -1;
}
static int
rxdigit(wint_t d)
{ if ( (int)d >= 0 && d <= 9 )
return d+'0';
if ( d >= 10 && d <= 15 )
return d-10+'a';
return -1;
}
#define mkfunction(name) \
static int f ## name(wint_t chr) { return name(chr); }
mkfunction(iswalnum)
mkfunction(iswalpha)
mkfunction(isascii)
mkfunction(iswcntrl)
mkfunction(iswdigit)
mkfunction(iswgraph)
mkfunction(iswlower)
mkfunction(iswupper)
mkfunction(iswpunct)
mkfunction(iswspace)
#ifdef __SWI_PROLOG__
#define INIT_DEF(Type, Name, Size) \
static void init_ ## Name (void) {} \
static const Type Name[] {
#define ADD_DEF2(Atom, Type) \
{ Atom, Type },
#define ADD_DEF5(Atom, Type, Reverse, Arity, Ctx) \
{ Atom, Type, Reverse, Arity, Ctx },
\
#define END_DEFS(Atom, F) \
{ Atom, F }
}
#endif
INIT_DEF(char_type, char_types, 26)
ADD_DEF2(ATOM_alnum, fiswalnum)
ADD_DEF2(ATOM_csym, fiscsym )
ADD_DEF2(ATOM_csymf, fiscsymf )
ADD_DEF2(ATOM_ascii, fisascii )
ADD_DEF2(ATOM_white, iswhite )
ADD_DEF2(ATOM_cntrl, fiswcntrl )
ADD_DEF2(ATOM_digit, fiswdigit )
ADD_DEF2(ATOM_graph, fiswgraph )
ADD_DEF2(ATOM_lower, fiswlower )
ADD_DEF2(ATOM_upper, fiswupper )
ADD_DEF2(ATOM_punct, fiswpunct )
ADD_DEF2(ATOM_space, fiswspace )
ADD_DEF2(ATOM_end_of_file,iseof )
ADD_DEF2(ATOM_end_of_line,iseol )
ADD_DEF2(ATOM_newline,isnl )
ADD_DEF2(ATOM_period,isperiod )
ADD_DEF2(ATOM_quote, isquote )
ADD_DEF5(ATOM_lower, fupper, flower, 1, CTX_CHAR )
ADD_DEF5(ATOM_upper, flower, fupper, 1, CTX_CHAR )
ADD_DEF5(ATOM_to_lower,ftoupper, ftolower, 1, CTX_CHAR )
ADD_DEF5(ATOM_to_upper,ftolower, ftoupper, 1, CTX_CHAR )
ADD_DEF5(ATOM_paren, fparen, rparen, 1, CTX_CHAR )
ADD_DEF5(ATOM_digit, fdigit, rdigit, 1, CTX_CODE )
ADD_DEF5(ATOM_xdigit,fxdigit, rxdigit, 1, CTX_CODE )
END_DEFS(NULL_ATOM, NULL)
static const char_type *
char_type_by_name(atom_t name, int arity)
{ const char_type *cc;
for(cc = char_types; cc->name; cc++)
{ if ( cc->name == name && cc->arity == arity )
return cc;
}
return NULL;
}
static int
advanceGen(generator *gen)
{ if ( gen->do_enum & ENUM_CHAR )
{ if ( ++gen->current == 256 )
fail;
} else
{ gen->class++;
if ( !gen->class->name )
fail;
}
succeed;
}
static int
unify_char_type(term_t type, const char_type *ct, int context, int how)
{ if ( ct->arity == 0 )
return PL_unify_atom(type, ct->name);
else /*if ( ct->arity == 1 )*/
{ if ( PL_unify_functor(type, PL_new_functor(ct->name, 1)) )
{ term_t a = PL_new_term_ref();
_PL_get_arg(1, type, a);
if ( ct->ctx_type == CTX_CHAR )
return PL_unify_char(a, context, how);
else
return PL_unify_integer(a, context);
}
}
fail;
}
static foreign_t
do_char_type(term_t chr, term_t class, control_t h, int how)
{ generator *gen;
fid_t fid;
switch( ForeignControl(h) )
{ case FRG_FIRST_CALL:
{ const char_type *cc = NULL;
int c;
int do_enum = ENUM_NONE;
atom_t cn;
int arity;
if ( PL_is_variable(chr) )
do_enum |= ENUM_CHAR;
if ( PL_is_variable(class) )
do_enum |= ENUM_CLASS;
if ( do_enum == ENUM_BOTH )
return PL_error("char_type", 2, NULL, ERR_INSTANTIATION);
if ( !(do_enum & ENUM_CHAR) )
{ if ( !PL_get_char(chr, &c, TRUE) )
fail;
if ( c == -1 )
return PL_unify_atom(class, ATOM_end_of_file);
}
if ( !(do_enum & ENUM_CLASS) )
{ if ( !PL_get_name_arity(class, &cn, &arity) ||
!(cc = char_type_by_name(cn, arity)) )
return PL_error("char_type", 2, NULL,
ERR_TYPE, ATOM_char_type, class);
}
if ( do_enum == ENUM_NONE )
{ if ( arity == 0 )
return (*cc->test)((wint_t)c) ? TRUE : FALSE;
else
{ int rval = (*cc->test)((wint_t)c);
if ( rval >= 0 )
{ term_t a = PL_new_term_ref();
int ok;
_PL_get_arg(1, class, a);
if ( cc->ctx_type == CTX_CHAR )
ok = PL_unify_char(a, rval, how);
else
ok = PL_unify_integer(a, rval);
if ( ok )
return TRUE;
else
do_enum = ENUM_CHAR; /* try the other way around */
} else
fail;
}
}
if ( do_enum == ENUM_CHAR && arity == 1 )
{ term_t a = PL_new_term_ref(); /* char_type(X, lower('A')) */
int ca;
_PL_get_arg(1, class, a);
if ( !PL_is_variable(a) )
{ if ( PL_get_char(a, &ca, FALSE) )
{ int c = (*cc->reverse)((wint_t)ca);
if ( c < 0 )
fail;
return PL_unify_char(chr, c, how);
}
fail; /* error */
}
}
gen = allocHeap(sizeof(*gen));
gen->do_enum = do_enum;
if ( do_enum & ENUM_CHAR )
{ gen->class = cc;
gen->current = -1;
} else if ( do_enum & ENUM_CLASS )
{ gen->class = char_types;
gen->current = c;
}
break;
}
case FRG_REDO:
gen = ForeignContextPtr(h);
break;
case FRG_CUTTED:
gen = ForeignContextPtr(h);
if ( gen )
freeHeap(gen, sizeof(*gen));
default:
succeed;
}
fid = PL_open_foreign_frame();
for(;;)
{ int rval;
if ( (rval = (*gen->class->test)((wint_t)gen->current)) )
{ if ( gen->do_enum & ENUM_CHAR )
{ if ( !PL_unify_char(chr, gen->current, how) )
goto next;
}
if ( gen->class->arity > 0 )
{ if ( rval < 0 ||
!unify_char_type(class, gen->class, rval, how) )
goto next;
} else if ( gen->do_enum & ENUM_CLASS )
{ if ( !unify_char_type(class, gen->class, rval, how) )
goto next;
}
if ( advanceGen(gen) ) /* ok, found one */
ForeignRedoPtr(gen);
else
{ freeHeap(gen, sizeof(*gen)); /* the only one */
succeed;
}
}
next:
PL_rewind_foreign_frame(fid);
if ( !advanceGen(gen) )
break;
}
freeHeap(gen, sizeof(*gen));
fail;
}
static
PRED_IMPL("char_type", 2, char_type, PL_FA_NONDETERMINISTIC)
{ return do_char_type(A1, A2, PL__ctx, CHAR_MODE);
}
static
PRED_IMPL("code_type", 2, code_type, PL_FA_NONDETERMINISTIC)
{ return do_char_type(A1, A2, PL__ctx, CODE_MODE);
}
#if 0
static
PRED_IMPL("iswctype", 2, iswctype, 0)
{ char *s;
int chr;
wctype_t t;
if ( !PL_get_char_ex(A1, &chr, FALSE) ||
!PL_get_chars_ex(A2, &s, CVT_ATOM) )
return FALSE;
if ( !(t=wctype(s)) )
return PL_error(NULL, 0, NULL, ERR_EXISTENCE, ATOM_type, A2);
return iswctype(chr, t) ? TRUE : FALSE;
}
#endif
static int
init_tout(PL_chars_t *t, size_t len)
{ switch(t->encoding)
{ case ENC_ISO_LATIN_1:
if ( len < sizeof(t->buf) )
{ t->text.t = t->buf;
t->storage = PL_CHARS_LOCAL;
} else
{ t->text.t = PL_malloc(len);
t->storage = PL_CHARS_MALLOC;
}
succeed;
case ENC_WCHAR:
if ( len*sizeof(pl_wchar_t) < sizeof(t->buf) )
{ t->text.w = (pl_wchar_t*)t->buf;
t->storage = PL_CHARS_LOCAL;
} else
{ t->text.w = PL_malloc(len*sizeof(pl_wchar_t));
t->storage = PL_CHARS_MALLOC;
}
succeed;
default:
assert(0);
fail;
}
}
static inline wint_t
get_chr_from_text(const PL_chars_t *t, size_t index)
{ switch(t->encoding)
{ case ENC_ISO_LATIN_1:
return t->text.t[index]&0xff;
case ENC_WCHAR:
return t->text.w[index];
default:
assert(0);
return 0;
}
}
static foreign_t
modify_case_atom(term_t in, term_t out, int down)
{ PL_chars_t tin, tout;
if ( !PL_get_text(in, &tin, CVT_ATOMIC|CVT_EXCEPTION) )
return FALSE;
if ( PL_get_text(out, &tout, CVT_ATOMIC) )
{ unsigned int i;
if ( tin.length != tout.length )
fail;
for(i=0; i<tin.length; i++)
{ wint_t ci = get_chr_from_text(&tin, i);
wint_t co = get_chr_from_text(&tout, i);
if ( down )
{ if ( co != towlower(ci) )
fail;
} else
{ if ( co != towupper(ci) )
fail;
}
}
succeed;
} else if ( PL_is_variable(out) )
{ unsigned int i;
tout.encoding = tin.encoding;
tout.length = tin.length;
tout.canonical = FALSE; /* or TRUE? Can WCHAR map to ISO? */
init_tout(&tout, tin.length);
if ( tin.encoding == ENC_ISO_LATIN_1 )
{ const unsigned char *in = (const unsigned char*)tin.text.t;
if ( down )
{ for(i=0; i<tin.length; i++)
{ wint_t c = towlower(in[i]);
if ( c > 255 )
{ PL_promote_text(&tout);
for( ; i<tin.length; i++)
{ tout.text.w[i] = towlower(in[i]);
}
break;
} else
{ tout.text.t[i] = (char)c;
}
}
} else /* upcase */
{ for(i=0; i<tin.length; i++)
{ wint_t c = towupper(in[i]);
if ( c > 255 )
{ PL_promote_text(&tout);
for( ; i<tin.length; i++)
{ tout.text.w[i] = towupper(in[i]);
}
break;
} else
{ tout.text.t[i] = (char)c;
}
}
}
} else
{ if ( down )
{ for(i=0; i<tin.length; i++)
{ tout.text.w[i] = towlower(tin.text.w[i]);
}
} else
{ for(i=0; i<tin.length; i++)
{ tout.text.w[i] = towupper(tin.text.w[i]);
}
}
}
PL_unify_text(out, 0, &tout, PL_ATOM);
PL_free_text(&tout);
succeed;
} else
{ return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_atom, out);
}
}
static
PRED_IMPL("downcase_atom", 2, downcase_atom, 0)
{ return modify_case_atom(A1, A2, TRUE);
}
static
PRED_IMPL("upcase_atom", 2, upcase_atom, 0)
{ return modify_case_atom(A1, A2, FALSE);
}
/*******************************
* WHITE SPACE *
*******************************/
static int
write_normalize_space(IOSTREAM *out, term_t in)
{ PL_chars_t tin;
size_t i, end;
if ( !PL_get_text(in, &tin, CVT_ATOMIC|CVT_EXCEPTION) )
return FALSE;
end = tin.length;
i = 0;
while(i<end && unicode_separator(get_chr_from_text(&tin, i)))
i++;
while( i<end )
{ wint_t c;
while(i<end && !unicode_separator((c=get_chr_from_text(&tin, i))))
{ if ( Sputcode(c, out) < 0 )
fail;
i++;
}
while(i<end && unicode_separator(get_chr_from_text(&tin, i)))
i++;
if ( i < end )
{ if ( Sputcode(' ', out) < 0 )
fail;
}
}
succeed;
}
static
PRED_IMPL("normalize_space", 2, normalize_space, 0)
{ redir_context ctx;
word rc;
EXCEPTION_GUARDED(/*code*/
if ( setupOutputRedirect(A1, &ctx, FALSE) )
{ if ( (rc = write_normalize_space(ctx.stream, A2)) )
rc = closeOutputRedirect(&ctx);
else
discardOutputRedirect(&ctx);
} else
rc = FALSE;
/*cleanup*/,
DEBUG(1, Sdprintf("Cleanup after throw()\n"));
discardOutputRedirect(&ctx);
rc = PL_rethrow(););
return rc;
}
/*******************************
* LOCALE *
*******************************/
#if defined(HAVE_LOCALE_H) && defined(HAVE_SETLOCALE)
#include <locale.h>
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Note: on some installations, locale doesn't work correctly. Printing a
message isn't really cute. It would be better to use printMessage(), but
the system isn't yet initialised far enough. Maybe we should store the
failure and print a message at the end of the initialisation?
We only return FALSE if LC_CTYPE fails. This is a serious indication
that locale support is broken. We don't depend too much on the others,
so we ignore possible problems.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static int
initLocale()
{ int rc = TRUE;
if ( !setlocale(LC_CTYPE, "") )
{ rc = FALSE;
DEBUG(0, Sdprintf("Failed to set LC_CTYPE locale\n"));
}
if ( !setlocale(LC_TIME, "") )
{ DEBUG(0, Sdprintf("Failed to set LC_TIME locale\n"));
}
if ( !setlocale(LC_COLLATE, "") )
{ DEBUG(0, Sdprintf("Failed to set LC_COLLATE locale\n"));
}
return rc;
}
typedef struct
{ int category;
const char *name;
} lccat;
static lccat lccats[] =
{ { LC_ALL, "all" },
{ LC_COLLATE, "collate" },
{ LC_CTYPE, "ctype" },
#ifdef LC_MESSAGES
{ LC_MESSAGES, "messages" },
#endif
{ LC_MONETARY, "monetary" },
{ LC_NUMERIC, "numeric" },
{ LC_TIME, "time" },
{ 0, NULL }
};
static
PRED_IMPL("setlocale", 3, setlocale, 0)
{ char *what;
char *locale;
const lccat *lcp;
if ( !PL_get_chars_ex(A1, &what, CVT_ATOM) )
fail;
if ( PL_is_variable(A3) )
locale = NULL;
else if ( !PL_get_chars_ex(A3, &locale, CVT_ATOM) )
fail;
for ( lcp = lccats; lcp->name; lcp++ )
{ if ( streq(lcp->name, what) )
{ char *old = setlocale(lcp->category, NULL);
if ( !PL_unify_chars(A2, PL_ATOM, -1, old) )
fail;
if ( PL_compare(A2, A3) != 0 )
{ if ( !setlocale(lcp->category, locale) )
return PL_error(NULL, 0, MSG_ERRNO, ERR_SYSCALL, "setlocale");
}
succeed;
}
}
return PL_error(NULL, 0, NULL, ERR_DOMAIN,
PL_new_atom("category"), A1);
}
#else
#define initLocale() 1
static
PRED_IMPL("setlocale", 3, setlocale, 0)
{ return notImplemented("setlocale", 3);
}
#endif
/*******************************
* PUBLISH PREDICATES *
*******************************/
BeginPredDefs(ctype)
PRED_DEF("char_type", 2, char_type, PL_FA_NONDETERMINISTIC)
PRED_DEF("code_type", 2, code_type, PL_FA_NONDETERMINISTIC)
PRED_DEF("setlocale", 3, setlocale, 0)
PRED_DEF("downcase_atom", 2, downcase_atom, 0)
PRED_DEF("upcase_atom", 2, upcase_atom, 0)
PRED_DEF("normalize_space", 2, normalize_space, 0)
EndPredDefs
/*******************************
* PROLOG CHARACTERS *
*******************************/
const char _PL_char_types[] = {
/* ^@ ^A ^B ^C ^D ^E ^F ^G ^H ^I ^J ^K ^L ^M ^N ^O 0-15 */
CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT,
/* ^P ^Q ^R ^S ^T ^U ^V ^W ^X ^Y ^Z ^[ ^\ ^] ^^ ^_ 16-31 */
CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT,
/* sp ! " # $ % & ' ( ) * + , - . / 32-47 */
SP, SO, DQ, SY, SY, SO, SY, SQ, PU, PU, SY, SY, PU, SY, SY, SY,
/* 0 1 2 3 4 5 6 7 8 9 : ; < = > ? 48-63 */
DI, DI, DI, DI, DI, DI, DI, DI, DI, DI, SY, SO, SY, SY, SY, SY,
/* @ A B C D E F G H I J K L M N O 64-79 */
SY, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC,
/* P Q R S T U V W X Y Z [ \ ] ^ _ 80-95 */
UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, PU, SY, PU, SY, UC,
/* ` a b c d e f g h i j k l m n o 96-111 */
SY, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC,
/* p q r s t u v w x y z { | } ~ ^? 112-127 */
LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, PU, PU, PU, SY, CT,
/* 128-159 (C1 controls) */
CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT,
CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT,
/* 160-255 (G1 graphics) */
/* ISO Latin 1 is assumed */
SP, SO, SO, SO, SO, SO, SO, SO, SO, SO, LC, SO, SO, SO, SO, SO,
SO, SO, SO, SO, SO, SO, SO, SO, SO, SO, LC, SO, SO, SO, SO, SO,
UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC,
UC, UC, UC, UC, UC, UC, UC, SO, UC, UC, UC, UC, UC, UC, UC, LC,
LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC,
LC, LC, LC, LC, LC, LC, LC, SO, LC, LC, LC, LC, LC, LC, LC, LC
};
typedef struct
{ const char *name;
IOENC encoding;
} enc_map;
static const enc_map map[] =
{ { "UTF-8", ENC_UTF8 },
{ "utf8", ENC_UTF8 },
{ "ISO8859-1", ENC_ISO_LATIN_1 },
{ "ISO8859_1", ENC_ISO_LATIN_1 },
{ "iso88591", ENC_ISO_LATIN_1 },
{ "iso_8859_1", ENC_ISO_LATIN_1 },
{ NULL, ENC_UNKNOWN }
};
static IOENC
initEncoding(void)
{ if ( LD )
{ if ( !LD->encoding )
{ char *enc;
if ( !initLocale() )
{ LD->encoding = ENC_ISO_LATIN_1;
} else if ( (enc = setlocale(LC_CTYPE, NULL)) )
{ LD->encoding = ENC_ANSI; /* text encoding */
if ( (enc = strchr(enc, '.')) )
{ const enc_map *m;
enc++; /* skip '.' */
for ( m=map; m->name; m++ )
{ if ( strcmp(enc, m->name) == 0 )
{ LD->encoding = m->encoding;
break;
}
}
}
} else
{ LD->encoding = ENC_ISO_LATIN_1;
}
}
return LD->encoding;
}
return ENC_ANSI;
}
void
initCharTypes(void)
{
init_char_types();
initEncoding();
}
#if __SWI_PROLOG__
bool
systemMode(bool accept)
{ bool old = SYSTEM_MODE ? TRUE : FALSE;
if ( accept )
debugstatus.styleCheck |= DOLLAR_STYLE;
else
debugstatus.styleCheck &= ~DOLLAR_STYLE;
return old;
}
#endif

82
LGPL/PLStream/pl-ctype.h Normal file
View File

@ -0,0 +1,82 @@
/* $Id$
Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: jan@swi.psy.uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2002, University of Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
extern const char _PL_char_types[]; /* array of character types */
#define CT 0 /* control-character */
#define SP 1 /* space */
#define SO 2 /* solo character */
#define SY 3 /* symbol character */
#define PU 4 /* Punctuation character */
#define DQ 5 /* Double quote */
#define SQ 6 /* Single quote */
#define BQ 7 /* Back quote */
#define UC 8 /* Uppercase character */
#define LC 9 /* Lowercase character */
#define DI 10 /* Digit */
#define isControl(c) (_PL_char_types[(unsigned)(c) & 0xff] == CT)
#define isBlank(c) (_PL_char_types[(unsigned)(c) & 0xff] <= SP)
#define isDigit(c) (_PL_char_types[(unsigned)(c) & 0xff] == DI)
#define isLower(c) (_PL_char_types[(unsigned)(c) & 0xff] == LC)
#define isUpper(c) (_PL_char_types[(unsigned)(c) & 0xff] == UC)
#define isSymbol(c) (_PL_char_types[(unsigned)(c) & 0xff] == SY)
#define isPunct(c) (_PL_char_types[(unsigned)(c) & 0xff] == PU)
#define isSolo(c) (_PL_char_types[(unsigned)(c) & 0xff] == SO)
#define isAlpha(c) (_PL_char_types[(unsigned)(c) & 0xff] >= UC)
#define isLetter(c) (isLower(c) || isUpper(c))
#define toLower(c) ((c) + 'a' - 'A')
#define makeLower(c) ((c) >= 'A' && (c) <= 'Z' ? toLower(c) : (c))
#define matchingBracket(c) ((c) == '[' ? ']' :\
'{' ? '}' :\
'(' ? ')' : EOS)
#define Control(c) ((c) == '?' ? 127 : (c) - '@')
/*******************************
* WIDE CHARACTER SUPPORT *
*******************************/
#include <wctype.h>
#include <wchar.h>
#define PlCharType(c, t, w) \
((unsigned)(c) <= 0xff ? (_PL_char_types[(unsigned char)(c)] t) : w)
#define isControlW(c) PlCharType(c, == CT, iswcntrl((wint_t)c))
#define isBlankW(c) PlCharType(c, <= SP, iswspace((wint_t)c))
#define isDigitW(c) PlCharType(c, == DI, FALSE)
#define isLowerW(c) PlCharType(c, == LC, iswlower((wint_t)c))
#define isUpperW(c) PlCharType(c, == UC, iswupper((wint_t)c))
#define isSymbolW(c) PlCharType(c, == SY, FALSE)
#define isPunctW(c) PlCharType(c, == PU, FALSE)
#define isSoloW(c) PlCharType(c, == SO, FALSE)
#define isAlphaW(c) PlCharType(c, >= UC, iswalnum((wint_t)c))
#define isLetterW(c) (PlCharType(c, == LC, iswalpha((wint_t)c)) || \
PlCharType(c, == UC, FALSE))
#define toLowerW(c) ((unsigned)(c) <= 'Z' ? (c) + 'a' - 'A' : towlower(c))
#define makeLowerW(c) ((c) >= 'A' && (c) <= 'Z' ? toLower(c) : towlower(c))

180
LGPL/PLStream/pl-error.c Normal file
View File

@ -0,0 +1,180 @@
#include "pl-incl.h"
void outOfCore(void) {}
void fatalError(const char *fm, ...) {exit(1);}
void printMessage(int type, ...) {}
/*******************************
* ERROR-CHECKING *_get() *
*******************************/
int
PL_get_nchars_ex(term_t t, size_t *len, char **s, unsigned int flags)
{ return PL_get_nchars(t, len, s, flags|CVT_EXCEPTION);
}
int
PL_get_chars_ex(term_t t, char **s, unsigned int flags)
{ return PL_get_nchars(t, NULL, s, flags|CVT_EXCEPTION);
}
int
PL_get_atom_ex(term_t t, atom_t *a)
{ if ( PL_get_atom(t, a) )
succeed;
return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_atom, t);
}
int
PL_get_integer_ex(term_t t, int *i)
{ if ( PL_get_integer(t, i) )
succeed;
if ( PL_is_integer(t) )
return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_int);
return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_integer, t);
}
int
PL_get_long_ex(term_t t, long *i)
{ if ( PL_get_long(t, i) )
succeed;
if ( PL_is_integer(t) )
return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_long);
return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_integer, t);
}
int
PL_get_int64_ex(term_t t, int64_t *i)
{ if ( PL_get_int64(t, i) )
succeed;
if ( PL_is_integer(t) )
return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_int64_t);
return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_integer, t);
}
int
PL_get_intptr_ex(term_t t, intptr_t *i)
{
#if SIZEOF_LONG != SIZEOF_VOIDP && SIZEOF_VOIDP == 8
return PL_get_int64_ex(t, i);
#else
return PL_get_long_ex(t, (long*)i);
#endif
}
int
PL_get_bool_ex(term_t t, int *i)
{ if ( PL_get_bool(t, i) )
succeed;
return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_bool, t);
}
int
PL_get_float_ex(term_t t, double *f)
{ if ( PL_get_float(t, f) )
succeed;
return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_float, t);
}
int
PL_get_char_ex(term_t t, int *p, int eof)
{ if ( PL_get_char(t, p, eof) )
succeed;
return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_character, t);
}
int
PL_unify_list_ex(term_t l, term_t h, term_t t)
{ if ( PL_unify_list(l, h, t) )
succeed;
if ( PL_get_nil(l) )
fail;
return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_list, l);
}
int
PL_unify_nil_ex(term_t l)
{ if ( PL_unify_nil(l) )
succeed;
if ( PL_is_list(l) )
fail;
return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_list, l);
}
int
PL_get_list_ex(term_t l, term_t h, term_t t)
{ if ( PL_get_list(l, h, t) )
succeed;
if ( PL_get_nil(l) )
fail;
return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_list, l);
}
int
PL_get_nil_ex(term_t l)
{ if ( PL_get_nil(l) )
succeed;
if ( PL_is_list(l) )
fail;
return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_list, l);
}
int
PL_get_module_ex(term_t name, module_t *m)
{ if ( !PL_get_module(name, m) )
return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_atom, name);
succeed;
}
int
PL_unify_bool_ex(term_t t, bool val)
{ bool v;
if ( PL_is_variable(t) )
return PL_unify_atom(t, val ? ATOM_true : ATOM_false);
if ( PL_get_bool(t, &v) )
{ if ( (!val && !v) || (val && v) )
succeed;
fail;
}
return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_bool, t);
}
word
notImplemented(char *name, int arity)
{ return (word)PL_error(NULL, 0, NULL, ERR_NOT_IMPLEMENTED_PROC, name, arity);
}

66
LGPL/PLStream/pl-error.h Normal file
View File

@ -0,0 +1,66 @@
/* $Id$
Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: jan@swi.psy.uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2002, University of Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#define ERR_NO_ERROR 0
#define ERR_INSTANTIATION 1 /* void */
#define ERR_TYPE 2 /* atom_t expected, term_t value */
#define ERR_DOMAIN 3 /* atom_t domain, term_t value */
#define ERR_REPRESENTATION 4 /* atom_t what */
#define ERR_MODIFY_STATIC_PROC 5 /* predicate_t proc */
#define ERR_EVALUATION 6 /* atom_t what */
#define ERR_AR_TYPE 7 /* atom_t expected, Number value */
#define ERR_NOT_EVALUABLE 8 /* functor_t func */
#define ERR_DIV_BY_ZERO 9 /* void */
#define ERR_FAILED 10 /* predicate_t proc */
#define ERR_FILE_OPERATION 11 /* atom_t action, atom_t type, term_t */
#define ERR_PERMISSION 12 /* atom_t type, atom_t op, term_t obj*/
#define ERR_NOT_IMPLEMENTED_FEATURE 13 /* const char *what */
#define ERR_EXISTENCE 14 /* atom_t type, term_t obj */
#define ERR_STREAM_OP 15 /* atom_t action, term_t obj */
#define ERR_RESOURCE 16 /* atom_t resource */
#define ERR_NOMEM 17 /* void */
#define ERR_SYSCALL 18 /* void */
#define ERR_SHELL_FAILED 19 /* term_t command */
#define ERR_SHELL_SIGNALLED 20 /* term_t command, int signal */
#define ERR_AR_UNDEF 21 /* void */
#define ERR_AR_OVERFLOW 22 /* void */
#define ERR_AR_UNDERFLOW 23 /* void */
#define ERR_UNDEFINED_PROC 24 /* Definition def */
#define ERR_SIGNALLED 25 /* int sig, char *name */
#define ERR_CLOSED_STREAM 26 /* IOSTREAM * */
#define ERR_BUSY 27 /* mutexes */
#define ERR_PERMISSION_PROC 28 /* op, type, Definition */
#define ERR_DDE_OP 29 /* op, error */
#define ERR_SYNTAX 30 /* what */
#define ERR_SHARED_OBJECT_OP 31 /* op, error */
#define ERR_TIMEOUT 32 /* op, object */
#define ERR_NOT_IMPLEMENTED_PROC 33 /* name, arity */
#define ERR_FORMAT 34 /* message */
#define ERR_FORMAT_ARG 35 /* seq, term */
#define ERR_OCCURS_CHECK 36 /* Word, Word */
#define ERR_CHARS_TYPE 37 /* char *, term */
#define ERR_MUST_BE_VAR 38 /* int argn, term_t term */
#define MSG_ERRNO ((char *)(-1))

View File

@ -0,0 +1,10 @@
int defFeature(const char *c, int f, ...) {
/**** add extra flags to engine: nowadays PL_set_prolog_flag */
return 0;
}
int trueFeature(int f) {
/**** define whether the feature is set or not */
return 0;
}

4768
LGPL/PLStream/pl-file.c Normal file

File diff suppressed because it is too large Load Diff

549
LGPL/PLStream/pl-incl.h Normal file
View File

@ -0,0 +1,549 @@
#include "config.h"
#include <SWI-Prolog.h>
#if HAVE_STRING_H
#include <string.h>
#endif
#define COMMON(X) X
#ifdef HAVE_LOCALE_H
#include <locale.h>
#endif
#include <setjmp.h>
#include <assert.h>
#if HAVE_SYS_PARAM_H
#include <sys/param.h> //MAXPATHLEN
#endif
#if __YAP_PROLOG__
#include "pl-yap.h"
#endif
/********************************
* UTILITIES *
*********************************/
#define ROUND(p, n) ((((p) + (n) - 1) & ~((n) - 1)))
/********************************
* HASH TABLES *
*********************************/
#include "pl-table.h"
#include "pl-stream.h"
#include "pl-os.h"
#include "pl-error.h"
/********************************
* BUFFERS *
*********************************/
#include "pl-buffer.h"
/*******************************
* OPTION LISTS *
*******************************/
#include "pl-opts.h"
// numbers
typedef enum
{ V_INTEGER, /* integer (64-bit) value */
#ifdef O_GMP
V_MPZ, /* mpz_t */
V_MPQ, /* mpq_t */
#endif
V_REAL /* Floating point number (double) */
} numtype;
typedef struct
{ numtype type; /* type of number */
union { double f; /* value as real */
int64_t i; /* value as integer */
word w[WORDS_PER_DOUBLE]; /* for packing/unpacking the double */
#ifdef O_GMP
mpz_t mpz; /* GMP integer */
mpq_t mpq; /* GMP rational */
#endif
} value;
} number, *Number;
typedef enum
{ CLN_NORMAL = 0, /* Normal mode */
CLN_ACTIVE, /* Started cleanup */
CLN_FOREIGN, /* Foreign hooks */
CLN_PROLOG, /* Prolog hooks */
CLN_SHARED, /* Unload shared objects */
CLN_DATA /* Remaining data */
} cleanup_status;
typedef struct tempfile * TempFile; /* pl-os.c */
typedef struct canonical_dir * CanonicalDir; /* pl-os.c */
typedef struct on_halt * OnHalt; /* pl-os.c */
/* The GD global variable */
struct {
int io_initialised;
cleanup_status cleaning; /* Inside PL_cleanup() */
struct
{ TempFile _tmpfile_head;
TempFile _tmpfile_tail;
CanonicalDir _canonical_dirlist;
char * myhome; /* expansion of ~ */
char * fred; /* last expanded ~user */
char * fredshome; /* home of fred */
OnHalt on_halt_list; /* list of onhalt hooks */
int halting; /* process is shutting down */
int gui_app; /* Win32: Application is a gui app */
IOFUNCTIONS iofunctions; /* initial IO functions */
IOFUNCTIONS org_terminal; /* IO+Prolog terminal functions */
IOFUNCTIONS rl_functions; /* IO+Terminal+Readline functions */
} os;
struct
{ atom_t * array; /* index --> atom */
size_t count; /* elements in array */
atom_t *for_code[256]; /* code --> one-char-atom */
} atoms;
} gds;
#define GD (&gds)
#define GLOBAL_LD (&gds)
// LOCAL variables (heap will get this form LOCAL
#define FT_ATOM 0 /* atom feature */
#define FT_BOOL 1 /* boolean feature (true, false) */
#define FT_INTEGER 2 /* integer feature */
#define FT_TERM 3 /* term feature */
#define FT_INT64 4 /* passed as int64_t */
#define FT_MASK 0x0f /* mask to get type */
#define FF_READONLY 0x10 /* feature is read-only */
#define FF_KEEP 0x20 /* keep value it already set */
typedef struct
{ unsigned long flags; /* the feature flags */
} pl_features_t;
typedef enum
{ OCCURS_CHECK_FALSE = 0,
OCCURS_CHECK_TRUE,
OCCURS_CHECK_ERROR
} occurs_check_t;
typedef struct
{ atom_t file; /* current source file */
int line; /* current line */
int linepos; /* position in the line */
int64_t character; /* current character location */
} source_location;
typedef struct exception_frame /* PL_throw exception environments */
{ struct exception_frame *parent; /* parent frame */
jmp_buf exception_jmp_env; /* longjmp environment */
} exception_frame;
#define EXCEPTION_GUARDED(code, cleanup) \
{ exception_frame __throw_env; \
__throw_env.parent = LD->exception.throw_environment; \
if ( setjmp(__throw_env.exception_jmp_env) != 0 ) \
{ LD->exception.throw_environment = __throw_env.parent; \
cleanup; \
} else \
{ LD->exception.throw_environment = &__throw_env; \
code; \
LD->exception.throw_environment = __throw_env.parent; \
} \
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
At times an abort is not allowed because the heap is inconsistent the
programmer should call startCritical to start such a code region and
endCritical to end it.
MT/TBD: how to handle this gracefully in the multi-threading case. Does
it mean anything?
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* vsc: needs defining */
#define startCritical
#define endCritical
/* The LD macro layer */
typedef struct PL_local_data {
struct /* Local IO stuff */
{ IOSTREAM *streams[6]; /* handles for standard streams */
struct input_context *input_stack; /* maintain input stream info */
struct output_context *output_stack; /* maintain output stream info */
} IO;
struct
{ Table table; /* Feature table */
pl_features_t mask; /* Masked access to booleans */
int write_attributes; /* how to write attvars? */
occurs_check_t occurs_check; /* Unify and occurs check */
} feature;
source_location read_source; /* file, line, char of last term */
struct
{ int active; /* doing pipe I/O */
jmp_buf context; /* context of longjmp() */
} pipe;
struct
{ atom_t current; /* current global prompt */
atom_t first; /* how to prompt first line */
int first_used; /* did we do the first line? */
int next; /* prompt on next read operation */
} prompt;
IOENC encoding; /* default I/O encoding */
struct
{ char * _CWDdir;
size_t _CWDlen;
#ifdef __BEOS__
status_t dl_error; /* dlopen() emulation in pl-beos.c */
#endif
int rand_initialised; /* have we initialised random? */
} os;
struct
{ term_t term; /* exception term */
term_t bin; /* temporary handle for exception */
term_t printed; /* already printed exception */
term_t tmp; /* tmp for errors */
term_t pending; /* used by the debugger */
int in_hook; /* inside exception_hook() */
exception_frame *throw_environment; /* PL_throw() environments */
} exception;
const char *float_format; /* floating point format */
buffer discardable_buffer; /* PL_*() character buffers */
buffer buffer_ring[BUFFER_RING_SIZE];
int current_buffer_id;
} PL_local_data_t;
#define features (LD->feature.mask)
PL_local_data_t lds;
#define exception_term (LD->exception.term)
// THIS HAS TO BE ABSTRACTED
#define LD (&lds)
#define LOCAL_LD (&lds)
#define ARG_LD
#define GET_LD
#define PRED_LD
#define PASS_LD
/* Support PL_LOCK in the interface */
#define PL_LOCK(X)
#define PL_UNLOCK(X)
#ifndef TRUE
#define TRUE 1
#define FALSE 0
#endif
#define succeed return TRUE
#define fail return FALSE
#define TRY(goal) if ((goal) == FALSE) fail
/* atom_t macro layer */
#define NULL_ATOM ((atom_t)0)
#include "atoms.h"
atom_t source_file_name; /** source name of the current file that we are
consulting */
int source_line_no; /** guess.... */
IOSTREAM * Suser_input;
IOSTREAM * Suser_output;
IOSTREAM * Suser_error;
IOSTREAM * Scurin; /* see/tell */
IOSTREAM * Scurout;
IOSTREAM * Sprotocol; /* protocolling */
int fileerrors;
int ttymode;
#define CHARESCAPE_FEATURE 0x00001 /* handle \ in atoms */
#define GC_FEATURE 0x00002 /* do GC */
#define TRACE_GC_FEATURE 0x00004 /* verbose gc */
#define TTY_CONTROL_FEATURE 0x00008 /* allow for tty control */
#define READLINE_FEATURE 0x00010 /* readline is loaded */
#define DEBUG_ON_ERROR_FEATURE 0x00020 /* start tracer on error */
#define REPORT_ERROR_FEATURE 0x00040 /* print error message */
#define FILE_CASE_FEATURE 0x00080 /* file names are case sensitive */
#define FILE_CASE_PRESERVING_FEATURE 0x0100 /* case preserving file names */
#define DOS_FILE_NAMES_FEATURE 0x00200 /* dos (8+3) file names */
#define ALLOW_VARNAME_FUNCTOR 0x00400 /* Read Foo(x) as 'Foo'(x) */
#define ISO_FEATURE 0x00800 /* Strict ISO compliance */
#define OPTIMISE_FEATURE 0x01000 /* -O: optimised compilation */
#define FILEVARS_FEATURE 0x02000 /* Expand $var and ~ in filename */
#define AUTOLOAD_FEATURE 0x04000 /* do autoloading */
#define CHARCONVERSION_FEATURE 0x08000 /* do character-conversion */
#define LASTCALL_FEATURE 0x10000 /* Last call optimization enabled? */
#define EX_ABORT_FEATURE 0x20000 /* abort with exception */
#define BACKQUOTED_STRING_FEATURE 0x40000 /* `a string` */
#define SIGNALS_FEATURE 0x80000 /* Handle signals */
#define DEBUGINFO_FEATURE 0x100000 /* generate debug info */
int defFeature(const char *c, int f, ...);
int trueFeature(int f);
/*******************************
* STREAM I/O *
*******************************/
#define REDIR_MAGIC 0x23a9bef3
typedef struct redir_context
{ int magic; /* REDIR_MAGIC */
IOSTREAM *stream; /* temporary output */
int is_stream; /* redirect to stream */
int redirected; /* output is redirected */
term_t term; /* redirect target */
int out_format; /* output type */
int out_arity; /* 2 for difference-list versions */
size_t size; /* size of I/O buffer */
char *data; /* data written */
char buffer[1024]; /* fast temporary buffer */
} redir_context;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Defining built-in predicates using the new interface
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#define EOS '\0'
#define ESC ((char) 27)
#define streq(s, q) ((strcmp((s), (q)) == 0))
#define CHAR_MODE 0 /* See PL_unify_char() */
#define CODE_MODE 1
#define BYTE_MODE 2
/* string stuff */
/*******************************
* STRING SUPPORT *
*******************************/
char * store_string(const char *s);
void remove_string(char *s);
/* from foreign interface */
/*******************************
* FILENAME SUPPORT *
*******************************/
#define PL_FILE_ABSOLUTE 0x01 /* return absolute path */
#define PL_FILE_OSPATH 0x02 /* return path in OS notation */
#define PL_FILE_SEARCH 0x04 /* use file_search_path */
#define PL_FILE_EXIST 0x08 /* demand file to exist */
#define PL_FILE_READ 0x10 /* demand read-access */
#define PL_FILE_WRITE 0x20 /* demand write-access */
#define PL_FILE_EXECUTE 0x40 /* demand execute-access */
#define PL_FILE_NOERRORS 0x80 /* do not raise exceptions */
#define PL_FA_ISO (0x20) /* Internal: ISO core predicate */
/********************************
* READ WARNINGS *
*********************************/
#define ReadingSource (source_line_no > 0 && \
source_file_name != NULL_ATOM)
#include <pl-text.h>
typedef double real;
#define true(s, a) ((s)->flags & (a))
#define false(s, a) (!true((s), (a)))
#define set(s, a) ((s)->flags |= (a))
#define clear(s, a) ((s)->flags &= ~(a))
#define DEBUG(LEVEL, COMMAND)
#define forwards static /* forwards function declarations */
#define PL_dispatch(FD, COM)
extern int PL_unify_char(term_t chr, int c, int how);
extern int PL_get_char(term_t chr, int *c, int eof);
extern int PL_get_text(term_t l, PL_chars_t *text, int flags);
extern void PL_cleanup_fork(void);
extern int PL_rethrow(void);
extern void PL_get_number(term_t l, number *n);
extern int PL_write_term(IOSTREAM *s, term_t term, int precedence, int flags);
extern int PL_unify_atomic(term_t t, PL_atomic_t a);
#define _PL_get_arg(X,Y,Z) PL_get_arg(X,Y,Z)
#define _PL_unify_atomic PL_unify_atomic
extern IOSTREAM ** /* provide access to Suser_input, */
_PL_streams(void); /* Suser_output and Suser_error */
#define PL_get_text__LD PL_get_text
#define getInputStream__LD getInputStream
extern int get_atom_text(atom_t atom, PL_chars_t *text);
extern int get_string_text(word w, PL_chars_t *text);
extern char *format_float(double f, char *buf, const char *format);
/**** stuff from pl-error.c ****/
extern int PL_get_bool_ex(term_t t, int *i);
extern int PL_get_nchars_ex(term_t t, size_t *len, char **s, unsigned int flags);
extern int PL_get_chars_ex(term_t t, char **s, unsigned int flags);
extern int PL_get_atom_ex(term_t t, atom_t *a);
extern int PL_get_integer_ex(term_t t, int *i);
extern int PL_get_long_ex(term_t t, long *i);
extern int PL_get_int64_ex(term_t t, int64_t *i);
extern int PL_get_intptr_ex(term_t t, intptr_t *i);
extern int PL_get_bool_ex(term_t t, int *i);
extern int PL_get_float_ex(term_t t, double *f);
extern int PL_get_char_ex(term_t t, int *p, int eof);
extern int PL_unify_list_ex(term_t l, term_t h, term_t t);
extern int PL_unify_nil_ex(term_t l);
extern int PL_get_list_ex(term_t l, term_t h, term_t t);
extern int PL_get_nil_ex(term_t l);
extern int PL_get_module_ex(term_t name, module_t *m);
extern int PL_unify_bool_ex(term_t t, bool val);
extern int PL_unify_bool_ex(term_t t, bool val);
extern int PL_get_bool_ex(term_t t, int *i);
extern int PL_get_integer_ex(term_t t, int *i);
/**** stuff from pl-file.c ****/
extern void initIO(void);
extern void dieIO(void);
extern void protocol(const char *str, size_t n);
extern bool readLine(IOSTREAM *in, IOSTREAM *out, char *buffer);
extern bool tellString(char **s, size_t *size, IOENC enc);
extern bool tellString(char **s, size_t *size, IOENC enc);
extern bool toldString(void);
extern int setupOutputRedirect(term_t to, redir_context *ctx, int redir);
extern void discardOutputRedirect(redir_context *ctx);
extern int closeOutputRedirect(redir_context *ctx);
extern IOENC atom_to_encoding(atom_t);
void closeFiles(int);
atom_t PrologPrompt(void);
word pl_current_input(term_t);
word pl_current_output(term_t);
word pl_exists_file(term_t name);
char *DirName(const char *f, char *dir);
void outOfCore(void);
word pl_noprotocol(void);
IOSTREAM *PL_current_input(void);
IOSTREAM *PL_current_output(void);
extern int PL_release_stream(IOSTREAM *s);
extern int PL_get_stream_handle(term_t t, IOSTREAM **s);
extern int PL_unify_stream_or_alias(term_t t, IOSTREAM *s);
extern int PL_unify_stream(term_t t, IOSTREAM *s);
extern bool PL_open_stream(term_t handle, IOSTREAM *s);
extern void PL_write_prompt(int dowrite);
/**** stuff from pl-error.c ****/
extern void outOfCore(void);
extern void fatalError(const char *fm, ...);
extern void printMessage(int type, ...);
extern int callProlog(void * module, term_t goal, int flags, term_t *ex);
extern word notImplemented(char *name, int arity);
/**** stuff from pl-ctype.c ****/
extern void initCharTypes(void);
/**** stuff from pl-os.c ****/
extern void cleanupOs(void);
extern void PL_clock_wait_ticks(intptr_t waited);
extern void setOSFeatures(void);
extern uintptr_t FreeMemory(void);
extern uint64_t _PL_Random(void);
extern void RemoveTemporaryFiles(void);
extern int Pause(real t);
char *findExecutable(const char *av0, char *buffer);
/**** SWI stuff (emulated in pl-yap.c) ****/
extern int writeAtomToStream(IOSTREAM *so, atom_t at);
extern int valueExpression(term_t t, Number r ARG_LD);
extern word lookupAtom(const char *s, size_t len);
extern atom_t lookupUCSAtom(const pl_wchar_t *s, size_t len);
extern atom_t codeToAtom(int chrcode);
extern int toIntegerNumber(Number n, int flags);
extern int get_atom_ptr_text(Atom a, PL_chars_t *text);
static inline word
setBoolean(int *flag, term_t old, term_t new)
{ if ( !PL_unify_bool_ex(old, *flag) ||
!PL_get_bool_ex(new, flag) )
fail;
succeed;
}
static inline word
setInteger(int *flag, term_t old, term_t new)
{ if ( !PL_unify_integer(old, *flag) ||
!PL_get_integer_ex(new, flag) )
fail;
succeed;
}
#if defined(__SWI_PROLOG__)
static inline word
INIT_SEQ_CODES(size_t n)
{
return allocGlobal(1+(n)*3); /* TBD: shift */
}
static inline word
EXTEND_SEQ_CODES(word gstore, int c) {
*gstore = consPtr(&gstore[1], TAG_COMPOUND|STG_GLOBAL);
gstore++;
*gstore++ = FUNCTOR_dot2;
*gstore++ = consInt(c);
return gstore;
}
static inline int
CLOSE_SEQ_OF_CODES(word gstore, word lp, word A2, word A3)) {
setVar(*gstore);
gTop = gstore+1;
a = valTermRef(A2);
deRef(a);
if ( !unify_ptrs(a, lp PASS_LD) )
return FALSE;
a = valTermRef(A3);
deRef(a);
if ( !unify_ptrs(a, gstore PASS_LD) )
return FALSE;
return TRUE;
}
#else
#endif

24
LGPL/PLStream/pl-opts.h Normal file
View File

@ -0,0 +1,24 @@
/*******************************
* OPTION LISTS *
*******************************/
#define OPT_BOOL (0) /* types */
#define OPT_INT (1)
#define OPT_STRING (2)
#define OPT_ATOM (3)
#define OPT_TERM (4) /* arbitrary term */
#define OPT_LONG (5)
#define OPT_NATLONG (6) /* > 0 */
#define OPT_TYPE_MASK 0xff
#define OPT_INF 0x100 /* allow 'inf' */
#define OPT_ALL 0x1 /* flags */
typedef struct
{ atom_t name; /* Name of option */
int type; /* Type of option */
} opt_spec, *OptSpec;
extern bool scan_options(term_t options, int flags, atom_t optype,
const opt_spec *specs, ...);

3157
LGPL/PLStream/pl-os.c Normal file

File diff suppressed because it is too large Load Diff

254
LGPL/PLStream/pl-os.h Normal file
View File

@ -0,0 +1,254 @@
/* $Id$
Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: jan@swi.psy.uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2002, University of Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#if TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
#endif
#ifdef HAVE_SYS_PARAM_H /* get MAXPATHLEN */
#include <sys/param.h>
#endif
/********************************
* MEMORY MANAGEMENT *
*********************************/
extern void *Allocate(intptr_t);
/********************************
* MISCELLANEOUS *
*********************************/
extern char *OsError(void);
extern bool initOs(void);
/********************************
* FILES *
*********************************/
#ifndef STREAM_OPEN_BIN_READ
#define STREAM_OPEN_BIN_READ "rb"
#endif
#ifndef STREAM_OPEN_BIN_WRITE
#define STREAM_OPEN_BIN_WRITE "wb"
#endif
#ifdef HAVE_POPEN
#define PIPE 1
#define Popen(path, m) Sopen_pipe(OsPath(path), m)
#define Pclose(fd) pclose(fd)
#endif
#ifndef MAXPATHLEN
#ifdef PATH_MAX
#define MAXPATHLEN PATH_MAX
#else
#ifdef PATHSIZE
#define MAXPATHLEN PATHSIZE
#endif
#endif
#endif
#define Fflush(fd) Sflush(fd)
#define Fclose(fd) Sclose(fd)
#define Open(path, how, mode) open(OsPath(path), how, mode)
#define Read(fd, buf, size) read(fd, buf, size)
#define Write(fd, buf, size) write(fd, buf, size)
#define Getc(fd) Sgetc(fd)
#define Putw(w, fd) Sputw((intptr_t)(w), fd)
#define Getw(fd) Sgetw(fd)
/*******************************
* PAGE AND TABLE-SIZE *
*******************************/
#ifdef HAVE_SYSCONF
#if defined(_SC_OPEN_MAX) && !defined(HAVE_GETPAGESIZE)
#undef getdtablesize
#define getdtablesize() sysconf(_SC_OPEN_MAX)
#ifndef HAVE_GETDTABLESIZE
#define HAVE_GETDTABLESIZE 1
#endif
#endif
#if defined(_SC_PAGESIZE) && !defined(HAVE_GETPAGESIZE)
#undef getpagesize
#define getpagesize() sysconf(_SC_PAGESIZE)
#ifndef HAVE_GETPAGESIZE
#define HAVE_GETPAGESIZE 1
#endif
#endif
#endif /*HAVE_SYSCONF*/
#ifndef HAVE_GETDTABLESIZE
extern int getdtablesize(void);
#endif
#ifndef HAVE_GETPAGESIZE
extern int getpagesize(void);
#endif
/*******************************
* FILE ACCESS *
*******************************/
#define ACCESS_EXIST 0
#define ACCESS_EXECUTE 1
#define ACCESS_READ 2
#define ACCESS_WRITE 4
/********************************
* TIME CONVERSION *
*********************************/
typedef enum
{ CPU_USER,
CPU_SYSTEM
} cputime_kind;
extern double CpuTime(cputime_kind);
extern double WallTime(void);
/*******************************
* MEMORY *
*******************************/
extern uintptr_t UsedMemory(void);
extern uintptr_t FreeMemory(void);
/********************************
* IOSTREAM DESCR. SETS *
********************************/
#if !defined(FD_ZERO) && !defined(__WINDOWS__)
#ifdef HAVE_SYS_SELECT_H
#include <sys/select.h>
#else
#define FD_ZERO(s) { *((uintptr_t *)(s)) = (0L); }
#define FD_SET(fd, s) { *((uintptr_t *)(s)) |= ((uintptr_t)L << (fd)); }
#define FD_ISSET(fd, s) ( (*((uintptr_t *)(s)) & ((uintptr_t)L << (fd))) != 0 )
#endif
#endif
/********************************
* TERMINAL CONTROL *
*********************************/
#define TTY_COOKED 1 /* Initial mode: echo */
#define TTY_RAW 2 /* Non-blocking, non-echo */
#define TTY_OUTPUT 3 /* enable post-processing */
#define TTY_SAVE 4 /* just save status */
#ifdef HAVE_TCSETATTR
#include <termios.h>
#include <unistd.h>
#define O_HAVE_TERMIO 1
#else /*HAVE_TCSETATTR*/
#ifdef HAVE_SYS_TERMIO_H
#include <sys/termio.h>
#define termios termio
#define O_HAVE_TERMIO 1
#else
#ifdef HAVE_SYS_TERMIOS_H
#include <sys/termios.h>
#define O_HAVE_TERMIO 1
#endif
#endif
#endif /*HAVE_TCSETATTR*/
#ifdef O_HAVE_TERMIO
typedef struct
{ struct termios tab; /* saved tty status */
int mode; /* Prolog;'s view on mode */
} ttybuf;
#else /* !O_HAVE_TERMIO */
#ifdef HAVE_SGTTYB
#include <sys/ioctl.h>
typedef struct
{ struct sgttyb tab; /* saved tty status */
int mode; /* Prolog;'s view on mode */
} ttybuf;
#else
typedef struct
{ int mode; /* Prolog;'s view on mode */
} ttybuf;
#endif /*HAVE_SGTTYB*/
#endif /*O_HAVE_TERMIO*/
extern ttybuf ttytab; /* saved tty status */
extern int ttymode; /* Current tty mode */
#define IsaTty(fd) isatty(fd)
extern bool PushTty(IOSTREAM *s, ttybuf *, int mode);
extern bool PopTty(IOSTREAM *s, ttybuf *);
extern void ResetTty(void);
/********************************
* PROCESS CONTROL *
*********************************/
extern int System(char *command);
extern char *ExpandOneFile(const char *spec, char *file);
extern char *AbsoluteFile(const char *spec, char *path);
extern int IsAbsolutePath(const char *spec);
extern char *ReadLink(const char *f, char *buf);
extern char *DeRefLink(const char *link, char *buf);
extern bool ExistsDirectory(const char *path);
extern bool AccessFile(const char *path, int mode);
extern bool AccessFile(const char *path, int mode);
extern char *OsPath(const char *plpath, char *path);
extern char *Getenv(const char *, char *buf, size_t buflen);
extern char *BaseName(const char *f);
extern intptr_t LastModifiedFile(char *f);
extern int64_t SizeFile(const char *path);
extern bool ExistsFile(const char *path);
extern atom_t TemporaryFile(const char *id);
extern int RemoveFile(const char *path);
extern bool SameFile(const char *f1, const char *f2);
extern bool RenameFile(const char *old, const char *new);
extern bool ChDir(const char *path);
extern bool MarkExecutable(const char *name);

3413
LGPL/PLStream/pl-stream.c Normal file

File diff suppressed because it is too large Load Diff

413
LGPL/PLStream/pl-stream.h Normal file
View File

@ -0,0 +1,413 @@
/* $Id$
Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: jan@science.uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2005, University of Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#ifndef _PL_STREAM_H
#define _PL_STREAM_H
/* This appears to make the wide-character support compile and work
on HPUX 11.23. There really should be a cleaner way ...
*/
#if defined(__hpux)
#include <sys/_mbstate_t.h>
#endif
#if defined(_MSC_VER) && !defined(__WINDOWS__)
#define __WINDOWS__ 1
#endif
#include <stdarg.h>
#include <wchar.h>
#include <stddef.h>
#ifdef __WINDOWS__
typedef __int64 int64_t;
#if (_MSC_VER < 1300)
typedef long intptr_t;
typedef unsigned long uintptr_t;
#endif
typedef intptr_t ssize_t; /* signed version of size_t */
#else
#include <unistd.h>
#include <inttypes.h> /* more portable than stdint.h */
#endif
#ifdef __cplusplus
extern "C" {
#endif
/*******************************
* EXPORT *
*******************************/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
See SWI-Prolog.h, containing the same code for an explanation on this
stuff.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#ifndef _PL_EXPORT_DONE
#define _PL_EXPORT_DONE
#if (defined(__WINDOWS__) || defined(__CYGWIN__)) && !defined(__LCC__)
#define HAVE_DECLSPEC
#endif
#ifdef HAVE_DECLSPEC
# ifdef PL_KERNEL
#define PL_EXPORT(type) __declspec(dllexport) type
#define PL_EXPORT_DATA(type) __declspec(dllexport) type
#define install_t void
# else
# ifdef __BORLANDC__
#define PL_EXPORT(type) type _stdcall
#define PL_EXPORT_DATA(type) extern type
# else
#define PL_EXPORT(type) extern type
#define PL_EXPORT_DATA(type) __declspec(dllimport) type
# endif
#define install_t __declspec(dllexport) void
# endif
#else /*HAVE_DECLSPEC*/
#define PL_EXPORT(type) extern type
#define PL_EXPORT_DATA(type) extern type
#define install_t void
#endif /*HAVE_DECLSPEC*/
#endif /*_PL_EXPORT_DONE*/
/*******************************
* CONSTANTS *
*******************************/
#ifndef EOF
#define EOF (-1)
#endif
#ifndef NULL
#define NULL ((void *)0)
#endif
#if defined(__WINDOWS__) && !defined(EWOULDBLOCK)
#define EWOULDBLOCK 1000 /* Needed for socket handling */
#endif
#define EPLEXCEPTION 1001 /* errno: pending Prolog exception */
#define SIO_BUFSIZE (4096) /* buffering buffer-size */
#define SIO_LINESIZE (1024) /* Sgets() default buffer size */
#define SIO_MAGIC (7212676) /* magic number */
#define SIO_CMAGIC (42) /* we are close (and thus illegal!) */
typedef ssize_t (*Sread_function)(void *handle, char *buf, size_t bufsize);
typedef ssize_t (*Swrite_function)(void *handle, char*buf, size_t bufsize);
typedef long (*Sseek_function)(void *handle, long pos, int whence);
typedef int64_t (*Sseek64_function)(void *handle, int64_t pos, int whence);
typedef int (*Sclose_function)(void *handle);
typedef int (*Scontrol_function)(void *handle, int action, void *arg);
#if defined(O_PLMT) && defined(PL_KERNEL)
#include "pl-mutex.h"
#define IOLOCK recursiveMutex
#else
typedef void * IOLOCK; /* Definition for external use */
#endif
typedef struct io_functions
{ Sread_function read; /* fill the buffer */
Swrite_function write; /* empty the buffer */
Sseek_function seek; /* seek to position */
Sclose_function close; /* close stream */
Scontrol_function control; /* Info/control */
Sseek64_function seek64; /* seek to position (intptr_t files) */
} IOFUNCTIONS;
typedef struct io_position
{ int64_t byteno; /* byte-position in file */
int64_t charno; /* character position in file */
int lineno; /* lineno in file */
int linepos; /* position in line */
intptr_t reserved[2]; /* future extensions */
} IOPOS;
/* NOTE: check with encoding_names */
/* in pl-file.c */
typedef enum
{ ENC_UNKNOWN = 0, /* invalid/unknown */
ENC_OCTET, /* raw 8 bit input */
ENC_ASCII, /* US-ASCII (0..127) */
ENC_ISO_LATIN_1, /* ISO Latin-1 (0..256) */
ENC_ANSI, /* default (multibyte) codepage */
ENC_UTF8,
ENC_UNICODE_BE, /* big endian unicode file */
ENC_UNICODE_LE, /* little endian unicode file */
ENC_WCHAR /* pl_wchar_t */
} IOENC;
#define SIO_NL_POSIX 0 /* newline as \n */
#define SIO_NL_DOS 1 /* newline as \r\n */
#define SIO_NL_DETECT 3 /* detect processing mode */
typedef struct io_stream
{ char *bufp; /* `here' */
char *limitp; /* read/write limit */
char *buffer; /* the buffer */
char *unbuffer; /* Sungetc buffer */
int lastc; /* last character written */
int magic; /* magic number SIO_MAGIC */
int bufsize; /* size of the buffer */
int flags; /* Status flags */
IOPOS posbuf; /* location in file */
IOPOS * position; /* pointer to above */
void *handle; /* function's handle */
IOFUNCTIONS *functions; /* open/close/read/write/seek */
int locks; /* lock/unlock count */
IOLOCK * mutex; /* stream mutex */
/* SWI-Prolog 4.0.7 */
void (*close_hook)(void* closure);
void * closure;
/* SWI-Prolog 5.1.3 */
int timeout; /* timeout (milliseconds) */
/* SWI-Prolog 5.4.4 */
char * message; /* error/warning message */
IOENC encoding; /* character encoding used */
struct io_stream * tee; /* copy data to this stream */
mbstate_t * mbstate; /* ENC_ANSI decoding */
struct io_stream * upstream; /* stream providing our input */
struct io_stream * downstream; /* stream providing our output */
unsigned newline : 2; /* Newline mode */
void * exception; /* pending exception (record_t) */
intptr_t reserved[2]; /* reserved for extension */
} IOSTREAM;
#define SmakeFlag(n) (1<<(n-1))
#define SIO_FBUF SmakeFlag(1) /* full buffering */
#define SIO_LBUF SmakeFlag(2) /* line buffering */
#define SIO_NBUF SmakeFlag(3) /* no buffering */
#define SIO_FEOF SmakeFlag(4) /* end-of-file */
#define SIO_FERR SmakeFlag(5) /* error ocurred */
#define SIO_USERBUF SmakeFlag(6) /* buffer is from user */
#define SIO_INPUT SmakeFlag(7) /* input stream */
#define SIO_OUTPUT SmakeFlag(8) /* output stream */
#define SIO_NOLINENO SmakeFlag(9) /* line no. info is void */
#define SIO_NOLINEPOS SmakeFlag(10) /* line pos is void */
#define SIO_STATIC SmakeFlag(11) /* Stream in static memory */
#define SIO_RECORDPOS SmakeFlag(12) /* Maintain position */
#define SIO_FILE SmakeFlag(13) /* Stream refers to an OS file */
#define SIO_PIPE SmakeFlag(14) /* Stream refers to an OS pipe */
#define SIO_NOFEOF SmakeFlag(15) /* don't set SIO_FEOF flag */
#define SIO_TEXT SmakeFlag(16) /* text-mode operation */
#define SIO_FEOF2 SmakeFlag(17) /* attempt to read past eof */
#define SIO_FEOF2ERR SmakeFlag(18) /* Sfpasteof() */
#define SIO_NOCLOSE SmakeFlag(19) /* Do not close on abort */
#define SIO_APPEND SmakeFlag(20) /* opened in append-mode */
#define SIO_UPDATE SmakeFlag(21) /* opened in update-mode */
#define SIO_ISATTY SmakeFlag(22) /* Stream is a tty */
#define SIO_CLOSING SmakeFlag(23) /* We are closing the stream */
#define SIO_TIMEOUT SmakeFlag(24) /* We had a timeout */
#define SIO_NOMUTEX SmakeFlag(25) /* Do not allow multi-thread access */
#define SIO_ADVLOCK SmakeFlag(26) /* File locked with advisory lock */
#define SIO_WARN SmakeFlag(27) /* Pending warning */
#define SIO_CLEARERR SmakeFlag(28) /* Clear error after reporting */
#define SIO_REPXML SmakeFlag(29) /* Bad char --> XML entity */
#define SIO_REPPL SmakeFlag(30) /* Bad char --> Prolog \hex\ */
#define SIO_BOM SmakeFlag(31) /* BOM was detected/written */
#define SIO_SEEK_SET 0 /* From beginning of file. */
#define SIO_SEEK_CUR 1 /* From current position. */
#define SIO_SEEK_END 2 /* From end of file. */
PL_EXPORT(IOSTREAM *) S__getiob(void); /* get DLL's __iob[] address */
PL_EXPORT_DATA(IOFUNCTIONS) Sfilefunctions; /* OS file functions */
PL_EXPORT_DATA(int) Slinesize; /* Sgets() linesize */
#if defined(__CYGWIN__) && !defined(PL_KERNEL)
#define S__iob S__getiob()
#else
PL_EXPORT_DATA(IOSTREAM) S__iob[3]; /* Libs standard streams */
#endif
#define Sinput (&S__iob[0]) /* Stream Sinput */
#define Soutput (&S__iob[1]) /* Stream Soutput */
#define Serror (&S__iob[2]) /* Stream Serror */
#define Sgetchar() Sgetc(Sinput)
#define Sputchar(c) Sputc((c), Soutput)
#define S__checkpasteeof(s,c) \
if ( (c)==-1 && (s)->flags & (SIO_FEOF|SIO_FERR) ) \
((s)->flags |= SIO_FEOF2)
#define S__updatefilepos_getc(s, c) \
((s)->position ? S__fupdatefilepos_getc((s), (c)) \
: S__fcheckpasteeof((s), (c)))
#define Snpgetc(s) ((s)->bufp < (s)->limitp ? (int)(*(s)->bufp++)&0xff \
: S__fillbuf(s))
#define Sgetc(s) S__updatefilepos_getc((s), Snpgetc(s))
/* Control-operations */
#define SIO_GETSIZE (1) /* get size of underlying object */
#define SIO_GETFILENO (2) /* get underlying file (if any) */
#define SIO_SETENCODING (3) /* modify encoding of stream */
#define SIO_FLUSHOUTPUT (4) /* flush output */
#define SIO_LASTERROR (5) /* string holding last error */
/* Sread_pending() */
#define SIO_RP_BLOCK 0x1 /* wait for new input */
#if IOSTREAM_REPLACES_STDIO
#undef FILE
#undef stdin
#undef stdout
#undef stderr
#undef putc
#undef getc
#undef putchar
#undef getchar
#undef feof
#undef ferror
#undef fileno
#undef clearerr
#define FILE IOSTREAM
#define stdin Sinput
#define stdout Soutput
#define stderr Serror
#define putc Sputc
#define getc Sgetc
#define fputc Sputc
#define fgetc Sgetc
#define getw Sgetw
#define putw Sputw
#define fread Sfread
#define fwrite Sfwrite
#define ungetc Sungetc
#define putchar Sputchar
#define getchar Sgetchar
#define feof Sfeof
#define ferror Sferror
#define clearerr Sclearerr
#define fflush Sflush
#define fseek Sseek
#define ftell Stell
#define fclose Sclose
#define fgets Sfgets
#define gets Sgets
#define fputs Sfputs
#define puts Sputs
#define fprintf Sfprintf
#define printf Sprintf
#define vprintf Svprintf
#define vfprintf Svfprintf
#define sprintf Ssprintf
#define vsprintf Svsprintf
#define fopen Sopen_file
#define fdopen Sfdopen
#define fileno Sfileno
#define popen Sopen_pipe
#endif /*IOSTREAM_REPLACES_STDIO*/
/*******************************
* PROTOTYPES *
*******************************/
PL_EXPORT(void) SinitStreams(void);
PL_EXPORT(void) Scleanup(void);
PL_EXPORT(void) Sreset(void);
PL_EXPORT(int) S__fupdatefilepos_getc(IOSTREAM *s, int c);
PL_EXPORT(int) S__fcheckpasteeof(IOSTREAM *s, int c);
PL_EXPORT(int) S__fillbuf(IOSTREAM *s);
PL_EXPORT(int) Sunit_size(IOSTREAM *s);
/* byte I/O */
PL_EXPORT(int) Sputc(int c, IOSTREAM *s);
PL_EXPORT(int) Sfgetc(IOSTREAM *s);
PL_EXPORT(int) Sungetc(int c, IOSTREAM *s);
/* multibyte I/O */
PL_EXPORT(int) Scanrepresent(int c, IOSTREAM *s);
PL_EXPORT(int) Sputcode(int c, IOSTREAM *s);
PL_EXPORT(int) Sgetcode(IOSTREAM *s);
PL_EXPORT(int) Sungetcode(int c, IOSTREAM *s);
/* word I/O */
PL_EXPORT(int) Sputw(int w, IOSTREAM *s);
PL_EXPORT(int) Sgetw(IOSTREAM *s);
PL_EXPORT(size_t) Sfread(void *data, size_t size, size_t elems,
IOSTREAM *s);
PL_EXPORT(size_t) Sfwrite(const void *data, size_t size, size_t elems,
IOSTREAM *s);
PL_EXPORT(int) Sfeof(IOSTREAM *s);
PL_EXPORT(int) Sfpasteof(IOSTREAM *s);
PL_EXPORT(int) Sferror(IOSTREAM *s);
PL_EXPORT(void) Sclearerr(IOSTREAM *s);
PL_EXPORT(void) Sseterr(IOSTREAM *s, int which, const char *message);
#ifdef _FLI_H_INCLUDED
PL_EXPORT(void) Sset_exception(IOSTREAM *s, term_t ex);
#else
PL_EXPORT(void) Sset_exception(IOSTREAM *s, intptr_t ex);
#endif
PL_EXPORT(int) Ssetenc(IOSTREAM *s, IOENC new_enc, IOENC *old_enc);
PL_EXPORT(int) Sflush(IOSTREAM *s);
PL_EXPORT(long) Ssize(IOSTREAM *s);
PL_EXPORT(int) Sseek(IOSTREAM *s, long pos, int whence);
PL_EXPORT(long) Stell(IOSTREAM *s);
PL_EXPORT(int) Sclose(IOSTREAM *s);
PL_EXPORT(char *) Sfgets(char *buf, int n, IOSTREAM *s);
PL_EXPORT(char *) Sgets(char *buf);
PL_EXPORT(ssize_t) Sread_pending(IOSTREAM *s,
char *buf, size_t limit, int flags);
PL_EXPORT(int) Sfputs(const char *q, IOSTREAM *s);
PL_EXPORT(int) Sputs(const char *q);
PL_EXPORT(int) Sfprintf(IOSTREAM *s, const char *fm, ...);
PL_EXPORT(int) Sprintf(const char *fm, ...);
PL_EXPORT(int) Svprintf(const char *fm, va_list args);
PL_EXPORT(int) Svfprintf(IOSTREAM *s, const char *fm, va_list args);
PL_EXPORT(int) Ssprintf(char *buf, const char *fm, ...);
PL_EXPORT(int) Svsprintf(char *buf, const char *fm, va_list args);
PL_EXPORT(int) Svdprintf(const char *fm, va_list args);
PL_EXPORT(int) Sdprintf(const char *fm, ...);
PL_EXPORT(int) Slock(IOSTREAM *s);
PL_EXPORT(int) StryLock(IOSTREAM *s);
PL_EXPORT(int) Sunlock(IOSTREAM *s);
PL_EXPORT(IOSTREAM *) Snew(void *handle, int flags, IOFUNCTIONS *functions);
PL_EXPORT(IOSTREAM *) Sopen_file(const char *path, const char *how);
PL_EXPORT(IOSTREAM *) Sfdopen(int fd, const char *type);
PL_EXPORT(int) Sfileno(IOSTREAM *s);
PL_EXPORT(IOSTREAM *) Sopen_pipe(const char *command, const char *type);
PL_EXPORT(IOSTREAM *) Sopenmem(char **buffer, size_t *sizep, const char *mode);
PL_EXPORT(IOSTREAM *) Sopen_string(IOSTREAM *s, char *buf, size_t sz, const char *m);
PL_EXPORT(int) Sclosehook(void (*hook)(IOSTREAM *s));
PL_EXPORT(void) Sfree(void *ptr);
PL_EXPORT(int) Sset_filter(IOSTREAM *parent, IOSTREAM *filter);
PL_EXPORT(void) Ssetbuffer(IOSTREAM *s, char *buf, size_t size);
PL_EXPORT(int64_t) Stell64(IOSTREAM *s);
PL_EXPORT(int) Sseek64(IOSTREAM *s, int64_t pos, int whence);
PL_EXPORT(int) ScheckBOM(IOSTREAM *s);
PL_EXPORT(int) SwriteBOM(IOSTREAM *s);
#ifdef __cplusplus
}
#endif
#endif /*_PL_STREAM_H*/

67
LGPL/PLStream/pl-string.c Normal file
View File

@ -0,0 +1,67 @@
#include "pl-incl.h"
/********************************
* STRINGS *
*********************************/
#ifdef O_DEBUG
#define CHAR_INUSE 0x42
#define CHAR_FREED 0x41
char *
store_string(const char *s)
{ if ( s )
{ GET_LD
char *copy = (char *)allocHeap(strlen(s)+2);
*copy++ = CHAR_INUSE;
strcpy(copy, s);
return copy;
} else
{ return NULL;
}
}
void
remove_string(char *s)
{ if ( s )
{ GET_LD
assert(s[-1] == CHAR_INUSE);
s[-1] = CHAR_FREED;
freeHeap(s-1, strlen(s)+2);
}
}
#else /*O_DEBUG*/
char *
store_string(const char *s)
{ if ( s )
{ GET_LD
char *copy = (char *)allocHeap(strlen(s)+1);
strcpy(copy, s);
return copy;
} else
{ return NULL;
}
}
void
remove_string(char *s)
{ if ( s )
{ GET_LD
freeHeap(s, strlen(s)+1);
}
}
#endif /*O_DEBUG*/

427
LGPL/PLStream/pl-table.c Normal file
View File

@ -0,0 +1,427 @@
/* $Id$
Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: jan@swi.psy.uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2002, University of Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
/*#define O_DEBUG 1*/
#include "pl-incl.h"
#ifdef O_PLMT
#define LOCK_TABLE(t) if ( t->mutex ) simpleMutexLock(t->mutex)
#define UNLOCK_TABLE(t) if ( t->mutex ) simpleMutexUnlock(t->mutex)
#else
#define LOCK_TABLE(t) (void)0
#define UNLOCK_TABLE(t) (void)0
#endif
static inline Symbol rawAdvanceTableEnum(TableEnum e);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
This file provides generic hash-tables. Most of the implementation is
rather straightforward. Special are the *TableEnum() functions to
create, advance over and destroy enumerator objects. These objects are
used to enumerate the symbols of these tables, used primarily for the
pl_current_* predicates.
The enumerators cause two things: (1) as intptr_t enumerators are
associated, the table will not be rehashed and (2) if symbols are
deleted that are referenced by an enumerator, the enumerator is
automatically advanced to the next free symbol. This, in general, makes
the enumeration of hash-tables safe.
TODO: abort should delete any pending enumerators. This should be
thread-local, as thread_exit/1 should do the same.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static void
allocHTableEntries(Table ht)
{ int n;
Symbol *p;
ht->entries = allocHeap(ht->buckets * sizeof(Symbol));
for(n=0, p = &ht->entries[0]; n < ht->buckets; n++, p++)
*p = NULL;
}
Table
newHTable(int buckets)
{ Table ht;
ht = allocHeap(sizeof(struct table));
ht->buckets = (buckets & ~TABLE_MASK);
ht->size = 0;
ht->enumerators = NULL;
ht->free_symbol = NULL;
ht->copy_symbol = NULL;
#ifdef O_PLMT
if ( (buckets & TABLE_UNLOCKED) )
ht->mutex = NULL;
else
{ ht->mutex = allocHeap(sizeof(simpleMutex));
simpleMutexInit(ht->mutex);
}
#endif
allocHTableEntries(ht);
return ht;
}
void
destroyHTable(Table ht)
{
#ifdef O_PLMT
if ( ht->mutex )
{ simpleMutexDelete(ht->mutex);
freeHeap(ht->mutex, sizeof(*ht->mutex));
ht->mutex = NULL;
}
#endif
clearHTable(ht);
freeHeap(ht->entries, ht->buckets * sizeof(Symbol));
freeHeap(ht, sizeof(struct table));
}
#if O_DEBUG || O_HASHSTAT
#define HASHSTAT(c) c
static int lookups;
static int cmps;
void
exitTables(int status, void *arg)
{ Sdprintf("hashstat: Anonymous tables: %d lookups using %d compares\n",
lookups, cmps);
}
#else
#define HASHSTAT(c)
#endif /*O_DEBUG*/
void
initTables()
{ static int done = FALSE;
if ( !done )
{ done = TRUE;
HASHSTAT(PL_on_halt(exitTables, NULL));
}
}
Symbol
lookupHTable(Table ht, void *name)
{ Symbol s = ht->entries[pointerHashValue(name, ht->buckets)];
HASHSTAT(lookups++);
for( ; s; s = s->next)
{ HASHSTAT(cmps++);
if ( s->name == name )
return s;
}
return NULL;
}
#ifdef O_DEBUG
void
checkHTable(Table ht)
{ int i;
int n = 0;
for(i=0; i<ht->buckets; i++)
{ Symbol s;
for(s=ht->entries[i]; s; s=s->next)
{ assert(lookupHTable(ht, s->name) == s);
n++;
}
}
assert(n == ht->size);
}
#endif
/* MT: Locked by calling addHTable()
*/
static void
rehashHTable(Table ht)
{ Symbol *oldtab;
int oldbucks;
int i;
oldtab = ht->entries;
oldbucks = ht->buckets;
ht->buckets *= 2;
allocHTableEntries(ht);
DEBUG(1, Sdprintf("Rehashing table %p to %d entries\n", ht, ht->buckets));
for(i=0; i<oldbucks; i++)
{ Symbol s, n;
for(s=oldtab[i]; s; s = n)
{ int v = (int)pointerHashValue(s->name, ht->buckets);
n = s->next;
s->next = ht->entries[v];
ht->entries[v] = s;
}
}
freeHeap(oldtab, oldbucks * sizeof(Symbol));
DEBUG(0, checkHTable(ht));
}
Symbol
addHTable(Table ht, void *name, void *value)
{ Symbol s;
int v;
LOCK_TABLE(ht);
v = (int)pointerHashValue(name, ht->buckets);
if ( lookupHTable(ht, name) )
{ UNLOCK_TABLE(ht);
return NULL;
}
s = allocHeap(sizeof(struct symbol));
s->name = name;
s->value = value;
s->next = ht->entries[v];
ht->entries[v] = s;
ht->size++;
DEBUG(9, Sdprintf("addHTable(0x%x, 0x%x, 0x%x) --> size = %d\n",
ht, name, value, ht->size));
if ( ht->buckets * 2 < ht->size && !ht->enumerators )
rehashHTable(ht);
UNLOCK_TABLE(ht);
DEBUG(1, checkHTable(ht));
return s;
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Note: s must be in the table!
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
void
deleteSymbolHTable(Table ht, Symbol s)
{ int v;
Symbol *h;
TableEnum e;
LOCK_TABLE(ht);
v = (int)pointerHashValue(s->name, ht->buckets);
h = &ht->entries[v];
for( e=ht->enumerators; e; e = e->next )
{ if ( e->current == s )
rawAdvanceTableEnum(e);
}
for( ; *h; h = &(*h)->next )
{ if ( *h == s )
{ *h = (*h)->next;
freeHeap(s, sizeof(struct symbol));
ht->size--;
break;
}
}
UNLOCK_TABLE(ht);
}
void
clearHTable(Table ht)
{ int n;
TableEnum e;
LOCK_TABLE(ht);
for( e=ht->enumerators; e; e = e->next )
{ e->current = NULL;
e->key = ht->buckets;
}
for(n=0; n < ht->buckets; n++)
{ Symbol s, q;
for(s = ht->entries[n]; s; s = q)
{ q = s->next;
if ( ht->free_symbol )
(*ht->free_symbol)(s);
freeHeap(s, sizeof(struct symbol));
}
ht->entries[n] = NULL;
}
ht->size = 0;
UNLOCK_TABLE(ht);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Table copyHTable(Table org)
Make a copy of a hash-table. This is used to realise the copy-on-write
as defined by SharedTable. The table is copied to have exactly the
same dimensions as the original. If the copy_symbol function is
provided, it is called to allow duplicating the symbols name or value
fields.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
Table
copyHTable(Table org)
{ Table ht;
int n;
ht = allocHeap(sizeof(struct table));
LOCK_TABLE(org);
*ht = *org; /* copy all attributes */
#ifdef O_PLMT
ht->mutex = NULL;
#endif
allocHTableEntries(ht);
for(n=0; n < ht->buckets; n++)
{ Symbol s, *q;
q = &ht->entries[n];
for(s = org->entries[n]; s; s = s->next)
{ Symbol s2 = allocHeap(sizeof(*s2));
*q = s2;
q = &s2->next;
s2->name = s->name;
s2->value = s->value;
if ( ht->copy_symbol )
(*ht->copy_symbol)(s2);
}
*q = NULL;
}
#ifdef O_PLMT
if ( org->mutex )
{ ht->mutex = allocHeap(sizeof(simpleMutex));
simpleMutexInit(ht->mutex);
}
#endif
UNLOCK_TABLE(org);
return ht;
}
/*******************************
* ENUMERATING *
*******************************/
TableEnum
newTableEnum(Table ht)
{ TableEnum e = allocHeap(sizeof(struct table_enum));
Symbol n;
LOCK_TABLE(ht);
e->table = ht;
e->key = 0;
e->next = ht->enumerators;
ht->enumerators = e;
n = ht->entries[0];
while(!n && ++e->key < ht->buckets)
n=ht->entries[e->key];
e->current = n;
UNLOCK_TABLE(ht);
return e;
}
void
freeTableEnum(TableEnum e)
{ TableEnum *ep;
Table ht;
if ( !e )
return;
ht = e->table;
LOCK_TABLE(ht);
for( ep=&ht->enumerators; *ep ; ep = &(*ep)->next )
{ if ( *ep == e )
{ *ep = (*ep)->next;
freeHeap(e, sizeof(*e));
break;
}
}
UNLOCK_TABLE(ht);
}
static inline Symbol
rawAdvanceTableEnum(TableEnum e)
{ Symbol s, n;
Table ht = e->table;
if ( !(s = e->current) )
return s;
n = s->next;
while(!n)
{ if ( ++e->key >= ht->buckets )
{ e->current = NULL;
return s;
}
n=ht->entries[e->key];
}
e->current = n;
return s;
}
Symbol
advanceTableEnum(TableEnum e)
{ Symbol s;
#ifdef O_PLMT
Table ht = e->table;
#endif
LOCK_TABLE(ht);
s = rawAdvanceTableEnum(e);
UNLOCK_TABLE(ht);
return s;
}

58
LGPL/PLStream/pl-table.h Normal file
View File

@ -0,0 +1,58 @@
/*****
Hash Tables pl-table.h
****/
#define LMASK_BITS 7 /* total # mask bits */
#define TABLE_MASK 0xf0000000UL
#define pointerHashValue(p, size) ((((intptr_t)(p) >> LMASK_BITS) ^ \
((intptr_t)(p) >> (LMASK_BITS+5)) ^ \
((intptr_t)(p))) & \
((size)-1))
typedef struct symbol * Symbol; /* symbol of hash table */
/* hash Table + lock + scaling + enumerator */
typedef struct table *Table;
typedef struct table_enum* TableEnum;
/* symbol table hash package */
struct table
{ int buckets; /* size of hash table */
int size; /* # symbols in the table */
TableEnum enumerators; /* Handles for enumeration */
#ifdef O_PLMT
simpleMutex *mutex; /* Mutex to guard table */
#endif
void (*copy_symbol)(Symbol s);
void (*free_symbol)(Symbol s);
Symbol *entries; /* array of hash symbols */
};
struct symbol
{ Symbol next; /* next in chain */
void * name; /* name entry of symbol */
void * value; /* associated value with name */
};
struct table_enum
{ Table table; /* Table we are working on */
int key; /* Index of current symbol-chain */
Symbol current; /* The current symbol */
TableEnum next; /* More choice points */
};
extern void initTables(void);
extern Table newHTable(int size);
extern void destroyHTable(Table ht);
extern Symbol lookupHTable(Table ht, void *name);
extern Symbol addHTable(Table ht, void *name, void *value);
extern void deleteSymbolHTable(Table ht, Symbol s);
extern void clearHTable(Table ht);
extern Table copyHTable(Table org);
extern TableEnum newTableEnum(Table ht);
extern void freeTableEnum(TableEnum e);
extern Symbol advanceTableEnum(TableEnum e);

1158
LGPL/PLStream/pl-text.c Normal file

File diff suppressed because it is too large Load Diff

80
LGPL/PLStream/pl-text.h Normal file
View File

@ -0,0 +1,80 @@
/* $Id$
Part of SWI-Prolog
Author: Jan Wielemaker and Anjo Anjewierden
E-mail: jan@swi.psy.uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2002, University of Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#ifndef PL_TEXT_H_INCLUDED
#define PL_TEXT_H_INCLUDED
typedef enum
{ PL_CHARS_MALLOC, /* malloced data */
PL_CHARS_RING, /* stored in the buffer ring */
PL_CHARS_HEAP, /* stored in program area (atoms) */
PL_CHARS_STACK, /* stored on the global stack */
PL_CHARS_LOCAL /* stored in in-line buffer */
} PL_chars_alloc_t;
typedef struct
{ union
{ char *t; /* tranditional 8-bit char* */
pl_wchar_t *w; /* wide character string */
} text;
size_t length;
/* private stuff */
IOENC encoding; /* how it is encoded */
PL_chars_alloc_t storage; /* how it is stored */
int canonical; /* TRUE: ENC_ISO_LATIN_1 or ENC_WCHAR */
char buf[100]; /* buffer for simple stuff */
} PL_chars_t;
#define PL_init_text(txt) \
{ (txt)->text.t = NULL; \
(txt)->encoding = ENC_UNKNOWN; \
(txt)->storage = PL_CHARS_LOCAL; \
(txt)->canonical = FALSE; \
}
extern int PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type);
extern int PL_unify_text_range(term_t term, PL_chars_t *text,
size_t from, size_t len, int type);
extern int PL_promote_text(PL_chars_t *text);
extern int PL_demote_text(PL_chars_t *text);
extern int PL_mb_text(PL_chars_t *text, int flags);
extern int PL_canonise_text(PL_chars_t *text);
extern int PL_cmp_text(PL_chars_t *t1, size_t o1, PL_chars_t *t2, size_t o2,
size_t len);
extern int PL_concat_text(int n, PL_chars_t **text, PL_chars_t *result);
extern void PL_free_text(PL_chars_t *text);
extern void PL_save_text(PL_chars_t *text, int flags);
extern int PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD);
extern atom_t textToAtom(PL_chars_t *text);
extern IOSTREAM * Sopen_text(PL_chars_t *text, const char *mode);
extern void PL_text_recode(PL_chars_t *text, IOENC encoding);
#endif /*PL_TEXT_H_INCLUDED*/

117
LGPL/PLStream/pl-utf8.c Normal file
View File

@ -0,0 +1,117 @@
/* $Id$
Part of SWI-Prolog
Author: Jan Wielemaker and Anjo Anjewierden
E-mail: jan@swi.psy.uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2002, University of Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#include <string.h> /* get size_t */
#include "pl-utf8.h"
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
UTF-8 Decoding, based on http://www.cl.cam.ac.uk/~mgk25/unicode.html
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#define CONT(i) ISUTF8_CB(in[i])
#define VAL(i, s) ((in[i]&0x3f) << s)
char *
_PL__utf8_get_char(const char *in, int *chr)
{ /* 2-byte, 0x80-0x7ff */
if ( (in[0]&0xe0) == 0xc0 && CONT(1) )
{ *chr = ((in[0]&0x1f) << 6)|VAL(1,0);
return (char *)in+2;
}
/* 3-byte, 0x800-0xffff */
if ( (in[0]&0xf0) == 0xe0 && CONT(1) && CONT(2) )
{ *chr = ((in[0]&0xf) << 12)|VAL(1,6)|VAL(2,0);
return (char *)in+3;
}
/* 4-byte, 0x10000-0x1FFFFF */
if ( (in[0]&0xf8) == 0xf0 && CONT(1) && CONT(2) && CONT(3) )
{ *chr = ((in[0]&0x7) << 18)|VAL(1,12)|VAL(2,6)|VAL(3,0);
return (char *)in+4;
}
/* 5-byte, 0x200000-0x3FFFFFF */
if ( (in[0]&0xfc) == 0xf8 && CONT(1) && CONT(2) && CONT(3) && CONT(4) )
{ *chr = ((in[0]&0x3) << 24)|VAL(1,18)|VAL(2,12)|VAL(3,6)|VAL(4,0);
return (char *)in+5;
}
/* 6-byte, 0x400000-0x7FFFFFF */
if ( (in[0]&0xfe) == 0xfc && CONT(1) && CONT(2) && CONT(3) && CONT(4) && CONT(5) )
{ *chr = ((in[0]&0x1) << 30)|VAL(1,24)|VAL(2,18)|VAL(3,12)|VAL(4,6)|VAL(5,0);
return (char *)in+4;
}
*chr = *in;
return (char *)in+1;
}
char *
_PL__utf8_put_char(char *out, int chr)
{ if ( chr < 0x80 )
{ *out++ = chr;
} else if ( chr < 0x800 )
{ *out++ = 0xc0|((chr>>6)&0x1f);
*out++ = 0x80|(chr&0x3f);
} else if ( chr < 0x10000 )
{ *out++ = 0xe0|((chr>>12)&0x0f);
*out++ = 0x80|((chr>>6)&0x3f);
*out++ = 0x80|(chr&0x3f);
} else if ( chr < 0x200000 )
{ *out++ = 0xf0|((chr>>18)&0x07);
*out++ = 0x80|((chr>>12)&0x3f);
*out++ = 0x80|((chr>>6)&0x3f);
*out++ = 0x80|(chr&0x3f);
} else if ( chr < 0x4000000 )
{ *out++ = 0xf8|((chr>>24)&0x03);
*out++ = 0x80|((chr>>18)&0x3f);
*out++ = 0x80|((chr>>12)&0x3f);
*out++ = 0x80|((chr>>6)&0x3f);
*out++ = 0x80|(chr&0x3f);
} else if ( (unsigned)chr < 0x80000000 )
{ *out++ = 0xfc|((chr>>30)&0x01);
*out++ = 0x80|((chr>>24)&0x3f);
*out++ = 0x80|((chr>>18)&0x3f);
*out++ = 0x80|((chr>>12)&0x3f);
*out++ = 0x80|((chr>>6)&0x3f);
*out++ = 0x80|(chr&0x3f);
}
return out;
}
size_t
utf8_strlen(const char *s, size_t len)
{ const char *e = &s[len];
unsigned int l = 0;
while(s<e)
{ int chr;
s = utf8_get_char(s, &chr);
l++;
}
return l;
}

61
LGPL/PLStream/pl-utf8.h Normal file
View File

@ -0,0 +1,61 @@
/* $Id$
Part of SWI-Prolog
Author: Jan Wielemaker and Anjo Anjewierden
E-mail: jan@swi.psy.uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2002, University of Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#ifndef UTF8_H_INCLUDED
#define UTF8_H_INCLUDED
#define UTF8_MALFORMED_REPLACEMENT 0xfffd
#define ISUTF8_MB(c) ((unsigned)(c) >= 0xc0 && (unsigned)(c) <= 0xfd)
#define ISUTF8_CB(c) (((c)&0xc0) == 0x80) /* Is continuation byte */
#define ISUTF8_FB2(c) (((c)&0xe0) == 0xc0)
#define ISUTF8_FB3(c) (((c)&0xf0) == 0xe0)
#define ISUTF8_FB4(c) (((c)&0xf8) == 0xf0)
#define ISUTF8_FB5(c) (((c)&0xfc) == 0xf8)
#define ISUTF8_FB6(c) (((c)&0xfe) == 0xfc)
#define UTF8_FBN(c) (!(c&0x80) ? 0 : \
ISUTF8_FB2(c) ? 1 : \
ISUTF8_FB3(c) ? 2 : \
ISUTF8_FB4(c) ? 3 : \
ISUTF8_FB5(c) ? 4 : \
ISUTF8_FB6(c) ? 5 : -1)
#define UTF8_FBV(c,n) ( n == 0 ? c : (c & ((0x01<<(6-n))-1)) )
#define utf8_get_char(in, chr) \
(*(in) & 0x80 ? _PL__utf8_get_char(in, chr) \
: (*(chr) = *(in), (char *)(in)+1))
#define utf8_put_char(out, chr) \
((chr) < 0x80 ? out[0]=(char)(chr), out+1 \
: _PL__utf8_put_char(out, (chr)))
extern char *_PL__utf8_get_char(const char *in, int *chr);
extern char *_PL__utf8_put_char(char *out, int chr);
extern size_t utf8_strlen(const char *s, size_t len);
#endif /*UTF8_H_INCLUDED*/

539
LGPL/PLStream/pl-yap.c Normal file
View File

@ -0,0 +1,539 @@
/* YAP support for some low-level SWI stuff */
#include <stdio.h>
#include "pl-incl.h"
static atom_t
uncachedCodeToAtom(int chrcode)
{ if ( chrcode < 256 )
{ char tmp[1];
tmp[0] = chrcode;
return lookupAtom(tmp, 1);
} else
{ pl_wchar_t tmp[2];
int new;
tmp[0] = chrcode;
tmp[1] = '\0';
return (atom_t)YAP_LookupWideAtom(tmp);
}
}
atom_t
codeToAtom(int chrcode)
{ atom_t a;
if ( chrcode == EOF )
return ATOM_end_of_file;
assert(chrcode >= 0);
if ( chrcode < (1<<15) )
{ int page = chrcode / 256;
int entry = chrcode % 256;
atom_t *pv;
if ( !(pv=GD->atoms.for_code[page]) )
{ pv = PL_malloc(256*sizeof(atom_t));
memset(pv, 0, 256*sizeof(atom_t));
GD->atoms.for_code[page] = pv;
}
if ( !(a=pv[entry]) )
{ a = pv[entry] = uncachedCodeToAtom(chrcode);
}
} else
{ a = uncachedCodeToAtom(chrcode);
}
return a;
}
int
PL_rethrow(void)
{ GET_LD
if ( LD->exception.throw_environment )
longjmp(LD->exception.throw_environment->exception_jmp_env, 1);
fail;
}
int
callProlog(module_t module, term_t goal, int flags, term_t *ex)
{ term_t g = PL_new_term_ref();
functor_t fd;
predicate_t proc;
if ( ex )
*ex = 0;
PL_strip_module(goal, &module, g);
if ( !PL_get_functor(g, &fd) )
{ PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_callable, goal);
if ( ex )
*ex = exception_term;
fail;
}
proc = PL_pred(fd, module);
{ int arity = arityFunctor(fd);
term_t args = PL_new_term_refs(arity);
qid_t qid;
int n, rval;
for(n=0; n<arity; n++)
_PL_get_arg(n+1, g, args+n);
qid = PL_open_query(module, flags, proc, args);
rval = PL_next_solution(qid);
if ( !rval && ex )
*ex = PL_exception(qid);
PL_cut_query(qid);
return rval;
}
}
int
PL_write_term(IOSTREAM *s, term_t term, int precedence, int flags)
{
YAP_Write(YAP_GetFromSlot(term), Sputc, flags);
return TRUE;
}
int
writeAtomToStream(IOSTREAM *so, atom_t at)
{
YAP_Write(YAP_MkAtomTerm((YAP_Atom)at), Sputc, 0);
return TRUE;
}
int
valueExpression(term_t t, Number r ARG_LD)
{ //return YAP__expression(t, r, 0 PASS_LD);
return 0;
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
toIntegerNumber(Number n, int flags)
Convert a number to an integer. Default, only rationals that happen to
be integer are converted. If TOINT_CONVERT_FLOAT is present, floating
point numbers are converted if they represent integers. If also
TOINT_TRUNCATE is provided non-integer floats are truncated to integers.
Note that if a double is out of range for int64_t, it never has a
fractional part.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
int
toIntegerNumber(Number n, int flags)
{
#if SWI_PROLOG
switch(n->type)
{ case V_INTEGER:
succeed;
#ifdef O_GMP
case V_MPZ:
succeed;
case V_MPQ: /* never from stacks iff integer */
if ( mpz_cmp_ui(mpq_denref(n->value.mpq), 1L) == 0 )
{ mpz_clear(mpq_denref(n->value.mpq));
n->value.mpz[0] = mpq_numref(n->value.mpq)[0];
n->type = V_MPZ;
succeed;
}
fail;
#endif
case V_REAL:
if ( (flags & TOINT_CONVERT_FLOAT) )
{ if ( double_in_int64_range(n->value.f) )
{ int64_t l = (int64_t)n->value.f;
if ( (flags & TOINT_TRUNCATE) ||
(double)l == n->value.f )
{ n->value.i = l;
n->type = V_INTEGER;
return TRUE;
}
return FALSE;
#ifdef O_GMP
} else
{ mpz_init_set_d(n->value.mpz, n->value.f);
n->type = V_MPZ;
return TRUE;
#endif
}
}
return FALSE;
}
#endif
assert(0);
fail;
}
int
_PL_unify_atomic(term_t t, PL_atomic_t a)
{
return YAP_Unify(Yap_GetFromSlot(t), (YAP_Term)a);
}
word lookupAtom(const char *s, size_t len)
{
return (word)YAP_LookupAtom(s);
}
atom_t lookupUCSAtom(const pl_wchar_t *s, size_t len)
{
return (atom_t)YAP_LookupWideAtom(s);
}
/*******************************
* OPTIONS *
*******************************/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Variable argument list:
atom_t name
int type OPT_ATOM, OPT_STRING, OPT_BOOL, OPT_INT, OPT_LONG
pointer value
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#define MAXOPTIONS 32
typedef union
{ bool *b; /* boolean value */
long *l; /* long value */
int *i; /* integer value */
char **s; /* string value */
word *a; /* atom value */
term_t *t; /* term-reference */
void *ptr; /* anonymous pointer */
} optvalue;
bool
scan_options(term_t options, int flags, atom_t optype,
const opt_spec *specs, ...)
{ va_list args;
const opt_spec *s;
optvalue values[MAXOPTIONS];
term_t list = PL_copy_term_ref(options);
term_t head = PL_new_term_ref();
term_t tmp = PL_new_term_ref();
term_t val = PL_new_term_ref();
int n;
if ( trueFeature(ISO_FEATURE) )
flags |= OPT_ALL;
va_start(args, specs);
for( n=0, s = specs; s->name; s++, n++ )
values[n].ptr = va_arg(args, void *);
va_end(args);
while ( PL_get_list(list, head, list) )
{ atom_t name;
int arity;
if ( PL_get_name_arity(head, &name, &arity) )
{ if ( name == ATOM_equals && arity == 2 )
{ PL_get_arg(1, head, tmp);
if ( !PL_get_atom(tmp, &name) )
goto itemerror;
PL_get_arg(2, head, val);
} else if ( arity == 1 )
{ PL_get_arg(1, head, val);
} else if ( arity == 0 )
PL_put_atom(val, ATOM_true);
} else if ( PL_is_variable(head) )
{ return PL_error(NULL, 0, NULL, ERR_INSTANTIATION);
} else
{ itemerror:
return PL_error(NULL, 0, NULL, ERR_DOMAIN, optype, head);
}
for( n=0, s = specs; s->name; n++, s++ )
{ if ( s->name == name )
{ switch((s->type & OPT_TYPE_MASK))
{ case OPT_BOOL:
{ atom_t aval;
if ( !PL_get_atom(val, &aval) )
fail;
if ( aval == ATOM_true || aval == ATOM_on )
*values[n].b = TRUE;
else if ( aval == ATOM_false || aval == ATOM_off )
*values[n].b = FALSE;
else
goto itemerror;
break;
}
case OPT_INT:
{ if ( !PL_get_integer(val, values[n].i) )
goto itemerror;
break;
}
case OPT_LONG:
{ if ( !PL_get_long(val, values[n].l) )
{ if ( (s->type & OPT_INF) && PL_is_inf(val) )
*values[n].l = LONG_MAX;
else
goto itemerror;
}
break;
}
case OPT_NATLONG:
{ if ( !PL_get_long(val, values[n].l) )
goto itemerror;
if ( *(values[n].l) <= 0 )
return PL_error(NULL, 0, NULL, ERR_DOMAIN,
ATOM_not_less_than_one, val);
break;
}
case OPT_STRING:
{ char *str;
if ( !PL_get_chars(val, &str, CVT_ALL) ) /* copy? */
goto itemerror;
*values[n].s = str;
break;
}
case OPT_ATOM:
{ atom_t a;
if ( !PL_get_atom(val, &a) )
goto itemerror;
*values[n].a = a;
break;
}
case OPT_TERM:
{ *values[n].t = val;
val = PL_new_term_ref(); /* can't reuse anymore */
break;
}
default:
assert(0);
fail;
}
break;
}
}
if ( !s->name && (flags & OPT_ALL) )
goto itemerror;
}
if ( !PL_get_nil(list) )
return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_list, list);
succeed;
}
int
get_atom_ptr_text(Atom a, PL_chars_t *text)
{ if (YAP_IsWideAtom(a))
{ pl_wchar_t *name = (pl_wchar_t *)YAP_WideAtomName(a);
text->text.w = name;
text->length = wcslen(name);
text->encoding = ENC_WCHAR;
} else
{ char *name = (char *)YAP_AtomName(a);
text->text.t = name;
text->length = strlen(name);
text->encoding = ENC_ISO_LATIN_1;
}
text->storage = PL_CHARS_HEAP;
text->canonical = TRUE;
succeed;
}
int
get_atom_text(atom_t atom, PL_chars_t *text)
{ Atom a = atomValue(atom);
return get_atom_ptr_text(a, text);
}
int
get_string_text(word w, PL_chars_t *text ARG_LD)
{ fail;
}
void
PL_get_number(term_t l, number *n) {
YAP_Term t = valHandle(l);
if (YAP_IsIntTerm(t)) {
n->type = V_INTEGER;
n->value.i = YAP_IntOfTerm(t);
#ifdef O_GMP
} else {
n->type = V_MPZ;
n->value.mpz = YAP_BigNumOfTerm(t);
#endif
}
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Formatting a float. This is very complicated as we must write floats
such that it can be read as a float. This means using the conventions of
the C locale and if the float happens to be integer as <int>.0.
Switching the locale is no option as locale handling is not thread-safe
and may have unwanted consequences for embedding. There is a intptr_t
discussion on the very same topic on the Python mailinglist. Many hacks
are proposed, none is very satisfactory. Richard O'Keefe suggested to
use ecvt(), fcvt() and gcvt(). These are not thread-safe. The GNU C
library provides *_r() variations that can do the trick. An earlier
patch used localeconv() to find the decimal point, but this is both
complicated and not thread-safe.
Finally, with help of Richard we decided to replace the first character
that is not a digit nor [eE], as this must be the decimal point.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#define isDigit(c) ((c) >= '0' && (c) <= '9')
char *
format_float(double f, char *buf, const char *format)
{ char *q;
sprintf(buf, format, f);
q = buf;
if ( *q == '-' ) /* skip -?[0-9]* */
q++;
while(*q && (isDigit(*q) || *q <= ' '))
q++;
switch( *q )
{ case '\0':
*q++ = '.';
*q++ = '0';
*q = EOS;
break;
case 'e':
case 'E':
break;
default:
*q = '.';
}
return buf;
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
codes_or_chars_to_buffer(term_t l, unsigned flags, int wide)
If l represents a list of codes or characters, return a buffer holding
the characters. If wide == TRUE the buffer contains objects of type
pl_wchar_t. Otherwise it contains traditional characters.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static int
charCode(YAP_Term w)
{ if ( YAP_IsAtomTerm(w) )
{
Atom a = atomValue(w);
if ( YAP_AtomNameLength(a) == 1) {
if (YAP_IsWideAtom(a)) {
return YAP_WideAtomName(a)[0];
}
return YAP_AtomName(a)[0];
}
}
return -1;
}
Buffer
codes_or_chars_to_buffer(term_t l, unsigned int flags, int wide)
{ GET_LD
Buffer b;
YAP_Term list = YAP_GetFromSlot(l);
YAP_Term arg;
enum { CHARS, CODES } type;
if ( YAP_IsPairTerm(list) )
{ arg = YAP_HeadOfTerm(list);
if ( YAP_IsIntTerm(arg) )
{ long int i = YAP_IntOfTerm(arg);
if ( i >= 0 && (wide || i < 256) )
{ type = CODES;
goto ok;
}
} else if ( charCode(arg) >= 0 )
{ type = CHARS;
goto ok;
}
} else if ( list != YAP_TermNil() )
{ return findBuffer(flags);
}
fail;
ok:
b = findBuffer(flags);
while( YAP_IsPairTerm(list) )
{ intptr_t c = -1;
arg = YAP_HeadOfTerm(list);
switch(type)
{ case CODES:
if ( YAP_IsIntTerm(arg) )
{ c = YAP_IntOfTerm(arg);
}
break;
case CHARS:
c = charCode(arg);
break;
}
if ( c < 0 || (!wide && c > 0xff) )
{ unfindBuffer(flags); /* TBD: check unicode range */
return NULL;
}
if ( wide )
addBuffer(b, (pl_wchar_t)c, pl_wchar_t);
else
addBuffer(b, (unsigned char)c, unsigned char);
list = YAP_TailOfTerm(list);
}
if ( list != YAP_TermNil() )
{ unfindBuffer(flags);
return NULL;
}
return b;
}

154
LGPL/PLStream/pl-yap.h Normal file
View File

@ -0,0 +1,154 @@
#ifndef PL_YAP_H
#define PL_YAP_H
#ifdef __YAP_PROLOG__
#if HAVE_CTYPE_H
#include <ctype.h>
#endif
#define SIZE_VOIDP SIZEOF_INT_P
#if SIZE_DOUBLE==SIZEOF_INT_P
#define WORDS_PER_DOUBLE 1
#else
#define WORDS_PER_DOUBLE 2
#endif
#if SIZEOF_LONG_INT==4
#define INT64_FORMAT "%lld"
#define INTBITSIZE 32
#else
#define INT64_FORMAT "%ld"
#define INTBITSIZE 64
#endif
typedef uintptr_t word; /* Anonymous 4 byte object */
typedef YAP_Term Word; /* Anonymous 4 byte object */
typedef YAP_Atom Atom;
//move this to SWI
typedef uintptr_t PL_atomic_t; /* same a word */
#define INIT_DEF(Type, Name, Size) \
static Type Name[Size]; \
static void init_ ## Name (void) { \
int i = 0;
#define ADD_DEF2(Atom, Type) \
char_types[i].name = Atom; \
char_types[i].test = Type; \
i++;
#define ADD_DEF5(Atom, Type, Reverse, Arity, Ctx) \
char_types[i].name = Atom; \
char_types[i].test = Type; \
char_types[i].reverse = Reverse; \
char_types[i].arity = Arity; \
char_types[i].ctx_type = Ctx; \
i++;
#define END_DEFS(Atom, F) \
char_types[i].name = Atom; \
char_types[i].test = F; \
}
#define ADD_ENCODING(Atom, Type) \
encoding_names[i].code = Atom; \
encoding_names[i].name = Type; \
i++;
#define END_ENCODINGS(Atom, F) \
encoding_names[i].code = Atom; \
encoding_names[i].name = F; \
}
#define ADD_OPEN4_OPT(Atom, Type) \
open4_options[i].name = Atom; \
open4_options[i].type = Type; \
i++;
#define END_OPEN4_DEFS(Atom, F) \
open4_options[i].name = Atom; \
open4_options[i].type = F; \
}
#define ADD_CLOSE2_OPT(Atom, Type) \
close2_options[i].name = Atom; \
close2_options[i].type = Type; \
i++;
#define END_CLOSE2_DEFS(Atom, F) \
close2_options[i].name = Atom; \
close2_options[i].type = F; \
}
#define ADD_SPROP(F1, F2) \
sprop_list[i].functor = F1; \
sprop_list[i].function = F2; \
i++;
#define END_SPROP_DEFS(F1, F2) \
sprop_list[i].functor = F1; \
sprop_list[i].function = F2; \
}
#define ADD_STDSTREAM(Atom) \
standardStreams[i] = Atom; \
i++;
#define END_STDSTREAMS(Atom) \
standardStreams[i] = Atom; \
}
#define MK_ATOM(X) ((atom_t)YAP_LookupAtom(X))
#define MKFUNCTOR(X,Y) ((functor_t)YAP_MkFunctor((YAP_Atom)(X),Y))
/*** memory allocation stuff: SWI wraps around malloc */
#define allocHeap(X) YAP_AllocSpaceFromYap(X)
#define freeHeap(X,Size) YAP_FreeSpaceFromYap(X)
#define stopItimer()
/* TBD */
static inline word
INIT_SEQ_CODES(size_t n)
{
return 0L; /* TBD: shift */
}
static inline word
EXTEND_SEQ_CODES(word gstore, int c) {
return gstore;
}
static inline int
CLOSE_SEQ_OF_CODES(word gstore, word lp, word t1, word t2) {
return TRUE;
}
static inline Word
valHandle(term_t tt)
{
return (word)YAP_GetFromSlot(tt);
}
#define arityFunctor(f) YAP_ArityOfFunctor((YAP_Functor)f)
#define stringAtom(w) YAP_AtomName((YAP_Atom)(w))
#define isInteger(A) (YAP_IsIntTerm((A)) && YAP_IsBigNumTerm((A)))
#define isString(A) FALSE
#define isAtom(A) YAP_IsAtomTerm((A))
#define isList(A) YAP_IsPairTerm((A))
#define isNil(A) ((A) == YAP_TermNil())
#define isReal(A)YAP_IsFloatTerm((A))
#define isVar(A) YAP_IsVarTerm((A))
#define varName(l, buf) buf
#define valReal(w) YAP_FloatOfTerm((w))
#define AtomLength(w) YAP_AtomNameLength(w)
#define atomValue(atom) ((YAP_Atom)atom)
#define argTermP(w,i) ((Word)((YAP_ArgsOfTerm(w)+(i))))
#define deRef(t) (t = YAP_Deref(t))
#define clearNumber(n)
#endif /* __YAP_PROLOG__ */
#endif /* PL_YAP_H */