Projects
Factory:RISC-V:Base
slang
Sign Up
Log In
Username
Password
Overview
Repositories
Revisions
Requests
Users
Attributes
Meta
Expand all
Collapse all
Changes of Revision 3
View file
_service:tar_scm:slang.spec
Changed
@@ -1,8 +1,8 @@ %bcond_with oniguruma Name: slang -Version: 2.3.2 -Release: 9 +Version: 2.3.3 +Release: 1 Summary: An interpreted language and programing library License: GPLv2+ URL: https://www.jedsoft.org/slang/ @@ -11,8 +11,7 @@ Provides: %{name}-slsh = %{version}-%{release} Obsoletes: %{name}-slsh < %{version}-%{release} -Patch6000: slang-getkey-memmove.patch -Patch6001: slang-sighuptest.patch +Patch0: slang-sighuptest.patch BuildRequires: gcc libpng-devel pcre-devel zlib-devel @@ -84,6 +83,9 @@ %{_mandir}/man1/slsh.1* %changelog +* Wed Jan 18 2023 fuanan <fuanan3@h-partners.com> - 2.3.3-1 +- update version to 2.3.3 + * Mon Aug 02 2021 chenyanpanHW <chenyanpan@huawei.com> - 2.3.2-9 - DESC: delete -Sgit from %autosetup, and delete BuildRequires git
View file
_service:tar_scm:slang-getkey-memmove.patch
Deleted
@@ -1,31 +0,0 @@ -commit d338fd6e949ef62e7eac4eb5c024059e02158b06 -Author: Miroslav Lichvar <mlichvar@redhat.com> -Date: Wed Jul 25 13:07:42 2018 +0200 - - Replaced memcpy in SLang_getkey - - memcpy() is not defined for overlapping buffers, i.e. it may copy bytes - in any direction. As SLMEMMOVE is not defined in slang, replace the - SLMEMCPY call with a for loop. - -diff --git a/src/slgetkey.c b/src/slgetkey.c -index 86e7946..d9bc678 100644 ---- a/src/slgetkey.c -+++ b/src/slgetkey.c -@@ -40,13 +40,13 @@ unsigned int SLang_getkey (void) - - if (SLang_Input_Buffer_Len) - { -- unsigned int imax; -+ unsigned int i, imax; - ch = (unsigned int) *SLang_Input_Buffer; - SLang_Input_Buffer_Len--; - imax = SLang_Input_Buffer_Len; - -- SLMEMCPY ((char *) SLang_Input_Buffer, -- (char *) (SLang_Input_Buffer + 1), imax); -+ for (i = 0; i < imax; i++) -+ SLang_Input_Bufferi = SLang_Input_Bufferi + 1; - } - else if (SLANG_GETKEY_ERROR == (ch = _pSLsys_getkey ())) return ch; -
View file
_service:tar_scm:slang-2.3.2.tar.bz2/INSTALL.pc -> _service:tar_scm:slang-2.3.3.tar.bz2/INSTALL.pc
Changed
@@ -28,13 +28,14 @@ The final step installs the library and its components. The actual work is carried out by slsh, which was created in step 2. Please -note, if you make an changes the installation paths in the makefile +note, if you make any changes the installation paths in the makefile after completing step 2, then you will need to rebuild it. That is, run `mingw32-make clean', then go to step 2. Finally you will need to make sure that the $PREFIX/bin directory is -in your PATH. Assuming that this has been done, you should be able -to run `slsh' at the CMD prompt. +in your PATH. Here, $PREFIX refers to the value of the PREFIX +variable in the Makefile. Assuming that this has been done, you +should be able to run `slsh' at the CMD prompt. More information on the makefile generation process is available in src/mkfiles/README.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/NEWS -> _service:tar_scm:slang-2.3.3.tar.bz2/NEWS
Changed
@@ -1,4 +1,11 @@ -NEWS for version 2.3.x -*-text-*- +-*-text-*- + +See changes.txt for a detailed list of changes. The changes described +below are highlights. + +=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x= + +NEWS for version 2.3.x 24 bit color support (new for version 2.3.1) ============================================ @@ -8,18 +15,20 @@ available for 64 bit Unix/VMS systems to keep binary compatibility. Support for 32 bit systems will be added in version 3. - Since not all terminals support true color, and it is not supported - by terminfo, 24 bit color is disabled by default. A list of - terminals that support true color may be found at - <https://gist.github.com/XVilka/8346728>. + The library tries to detect the terminal's support for 24 bit true by + looking for the "RGB" terminfo flag. If this flag exists, and is + TRUE then true color will be enabled. Note that this this flag is a + relatively recent addition to terminfo and is defined by the + so-called user-defined terminfo extension. A list of terminals that + support true color may be found at <https://github.com/termstandard/colors>. - To indicate that a terminal supports true color, set the value of - the environment variable COLORTERM to either "24bit" or "truecolor", - e.g., + If the terminal supports 24 bit true color, but the library does not + detect it, then set the value of the environment variable COLORTERM + to either "24bit" or "truecolor", e.g., export COLORTERM=truecolor - Then to use 24 bit color in applications such as jed and slrn, use a + To use 24 bit color in applications such as jed and slrn, use a 24bit RGB value in the form "#RRGGBB" as the name of the color. For example, to set the color of the status line in jed to AliceBlue (#F0F8FF) on a SlateGray (#708090) background, use @@ -38,8 +47,7 @@ =========== 1. base64: A base64 encoder/decoder module - 2. chksum: A module for computing various checksums (currently md5 - and sha1) + 2. chksum: A module for computing various checksums (md5, sha1, ...) 3. stats: A statistics module 4. histogram: A histogram module 5. json: Encode/decode json structures @@ -48,7 +56,15 @@ ============== stats-module: Added Anderson-Darling normality and - k-sample tests (version 2.3.1) + k-sample tests (version 2.3.1) + Added a cumulant function (version 2.3.3) + + chksum-module: + 8, 16, and 32 bit CRCs were added (version 2.3.3) + sha224, sha256, sha384, and sha512 added (version 2.3.3) + HMAC added (version 2.3.3) + + Intrinsic Functions =================== @@ -92,8 +108,13 @@ _array_byteswap: used to convert the values of an array from one endianness to another (version 2.3.2) + fclock: Apply an advisory lock (version 2.3.3) + The following functions have been enhanced: + stat_file was modifed to accept an open file descriptor (version + 2.3.3) + array_map modified to support multiple return values. is_substrbytes: Added support for an optional offset into the @@ -102,6 +123,10 @@ _push_struct_field_values: An optional argument may be used to specify the fields to be pushed. (version 2.3.1) + fgetslines: Added support for a "trim" qualifier to indicate how + leading/trailing whitespace is to be handled (version 2.3.3) + + Interpreter Syntax ================== @@ -132,6 +157,13 @@ rearrange: Performs an in-place arrangement of values in an array or list (defined in arrayfuns.sl). + timestamp.sl: Parses timestamp strings such as Thu May 14 18:05:05 + 2020 and returns the number of seconds since the Unix epoch + (version 2.3.3) + + slcov: produces an LCOV compatible code coverage data for slang + scripts (version 2.3.3). See <http://jedsoft.org/slang/slcov/> + for some examples slsh ==== @@ -145,6 +177,12 @@ Note: The slang 2.3.x API is backward binary compatible with slang 2.y.z. + The size of the interpreter's runtime stack is now dynamically + allocated and can grow up to a maximum configured size (version + 2.3.3) + + Added support for TERMINFO_DIR (version 2.3.3) + Font attributes (italics, bold, underline, ...) may be enabled for terminals that support them by using a color name with a qualifier: @@ -214,8 +252,12 @@ Miscellaneous ============= - Support was added to support 32-bit terminfo database - entries introduced by ncurses 6.1 (version 2.3.2) + Support was added to support 32-bit terminfo database entries + introduced by ncurses 6.1 (version 2.3.2), and (in version 2.3.3) + for so-called user-defined terminfo extensions. In particular, if + the terminfo file defines RGB=true, then truecolor support will be + enabled. + =x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=x=
View file
_service:tar_scm:slang-2.3.2.tar.bz2/autoconf/aclocal.m4 -> _service:tar_scm:slang-2.3.3.tar.bz2/autoconf/aclocal.m4
Changed
@@ -1,4 +1,6 @@ dnl# -*- mode: sh; mode: fold -*- +dnl# 0.3.4.1: Added /{lib,etc}/terminfo to terminfo directory list +dnl# 0.3.4.0: Added $(CPPFLAGS) dnl# 0.3.3-1: Use INSTALL instead of INSTALL_DATA to install modules to get executable permissions dnl# 0.3.3-0: Added $(OBJ_O_DEPS) and $(ELF_O_DEPS) to PROGRAM_OBJECT_RULES dnl# 0.3.2-0: Add rpath support for freebsd @@ -352,7 +354,7 @@ AC_DEFUN(JD_GCC_WARNINGS, dnl#{{{ AC_ARG_ENABLE(warnings, - AC_HELP_STRING(--enable-warnings,turn on GCC compiler warnings), + AS_HELP_STRING(--enable-warnings,turn on GCC compiler warnings), gcc_warnings=$enableval) if test -n "$GCC" then @@ -511,7 +513,8 @@ /usr/lib/terminfo \ /usr/share/terminfo \ /usr/share/lib/terminfo \ - /usr/local/lib/terminfo" + /usr/local/lib/terminfo \ + /etc/terminfo /lib/terminfo" TERMCAP=-ltermcap for terminfo_dir in $JD_Terminfo_Dirs @@ -535,11 +538,12 @@ AC_DEFUN(JD_ANSI_CC, dnl#{{{ -AC_AIX +dnl# AC_AIX +AC_USE_SYSTEM_EXTENSIONS AC_REQUIRE(AC_PROG_CC) AC_REQUIRE(AC_PROG_CPP) AC_REQUIRE(AC_PROG_GCC_TRADITIONAL) -AC_ISC_POSIX +dnl# AC_ISC_POSIX dnl #This stuff came from Yorick config script dnl @@ -615,30 +619,30 @@ *linux*|*gnu*|k*bsd*-gnu ) DYNAMIC_LINK_FLAGS="-Wl,-export-dynamic" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fPIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fPIC" ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-O1 -Wl,--version-script,\$(VERSION_SCRIPT) -Wl,-soname,\$(ELFLIB_MAJOR)" ELF_DEP_LIBS="\$(DL_LIB) -lm -lc" CC_SHARED_FLAGS="-shared -fPIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" ;; *solaris* ) if test "$GCC" = yes then DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fPIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fPIC" ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-ztext -Wl,-h,\$(ELFLIB_MAJOR)" ELF_DEP_LIBS="\$(DL_LIB) -lm -lc" CC_SHARED_FLAGS="-G -fPIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" else DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -K PIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -K PIC" ELF_LINK="\$(CC) \$(LDFLAGS) -G -h\$(ELFLIB_MAJOR)" ELF_DEP_LIBS="\$(DL_LIB) -lm -lc" CC_SHARED_FLAGS="-G -K PIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" fi ;; # osr5 or unixware7 with current or late autoconf @@ -647,20 +651,20 @@ then DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fPIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fPIC" ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-h,\$(ELFLIB_MAJOR)" ELF_DEP_LIBS= CC_SHARED_FLAGS="-G -fPIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" else DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -K pic" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -K pic" # ELF_LINK="ld -G -z text -h#" ELF_LINK="\$(CC) \$(LDFLAGS) -G -z text -h\$(ELFLIB_MAJOR)" ELF_DEP_LIBS= CC_SHARED_FLAGS="-G -K pic" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" fi ;; *irix6.5* ) @@ -671,29 +675,29 @@ # not tested DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fPIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fPIC" ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-h,\$(ELFLIB_MAJOR)" ELF_DEP_LIBS= CC_SHARED_FLAGS="-shared -fPIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" else DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS)" # default anyhow + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS)" # default anyhow ELF_LINK="\$(CC) \$(LDFLAGS) -shared -o \$(ELFLIB_MAJOR)" ELF_DEP_LIBS= CC_SHARED_FLAGS="-shared" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" fi ;; *darwin* ) DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fno-common" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fno-common" ELF_LINK="\$(CC) \$(LDFLAGS) -dynamiclib -install_name \$(install_lib_dir)/\$(ELFLIB_MAJOR) -compatibility_version \$(ELF_MAJOR_VERSION) -current_version \$(ELF_MAJOR_VERSION).\$(ELF_MINOR_VERSION)" ELF_DEP_LIBS="\$(LDFLAGS) \$(DL_LIB)" CC_SHARED_FLAGS="-bundle -flat_namespace -undefined suppress -fno-common" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" ELFLIB="lib\$(THIS_LIB).dylib" ELFLIB_MAJOR="lib\$(THIS_LIB).\$(ELF_MAJOR_VERSION).dylib" ELFLIB_MAJOR_MINOR="lib\$(THIS_LIB).\$(ELF_MAJOR_VERSION).\$(ELF_MINOR_VERSION).dylib" @@ -701,7 +705,7 @@ ;; *freebsd* ) ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fPIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fPIC" #if test "X$PORTOBJFORMAT" = "Xelf" ; then # ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-soname,\$(ELFLIB_MAJOR)" #else @@ -710,19 +714,19 @@ ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-soname,\$(ELFLIB_MAJOR)" ELF_DEP_LIBS="\$(DL_LIB) -lm" CC_SHARED_FLAGS="-shared -fPIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" ;; *cygwin* ) DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" SLANG_DLL_CFLAGS="-DSLANG_DLL=1" - ELF_CFLAGS="\$(CFLAGS) -DBUILD_DLL=1" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -DBUILD_DLL=1" DLL_IMPLIB_NAME="lib\$(THIS_LIB)\$(ELFLIB_MAJOR_VERSION).dll.a" #ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-O1 -Wl,--version-script,\$(VERSION_SCRIPT) -Wl,-soname,\$(ELFLIB_MAJOR) -Wl,--out-implib=\$(DLL_IMPLIB_NAME) -Wl,-export-all-symbols -Wl,-enable-auto-import" ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-O1 -Wl,--version-script,\$(VERSION_SCRIPT) -Wl,-soname,\$(ELFLIB_MAJOR) -Wl,--out-implib=\$(DLL_IMPLIB_NAME)" ELF_DEP_LIBS="\$(DL_LIB) -lm" CC_SHARED_FLAGS="-shared -DSLANG_DLL=1" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" dnl# CYGWIN prohibits undefined symbols when linking shared libs SLANG_LIB_FOR_MODULES="-L\$(ELFDIR) -lslang" INSTALL_MODULE="\$(INSTALL)" @@ -737,20 +741,20 @@ M_LIB="" DYNAMIC_LINK_FLAGS="-Wl,-export-dynamic" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fPIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fPIC" ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-O1 -Wl,--version-script,\$(VERSION_SCRIPT) -Wl,-soname,\$(ELFLIB_MAJOR)" ELF_DEP_LIBS="\$(DL_LIB)" CC_SHARED_FLAGS="-shared -fPIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" ;; * ) echo "Note: ELF compiler for host_os=$host_os may be wrong" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fPIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fPIC" ELF_LINK="\$(CC) \$(LDFLAGS) -shared" ELF_DEP_LIBS="\$(DL_LIB) -lm -lc" CC_SHARED_FLAGS="-shared -fPIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" esac AC_SUBST(ELF_CC)
View file
_service:tar_scm:slang-2.3.2.tar.bz2/autoconf/configure.ac -> _service:tar_scm:slang-2.3.3.tar.bz2/autoconf/configure.ac
Changed
@@ -182,6 +182,7 @@ ttyname ttyname_r \ newlocale strtod_l localeconv \ statvfs \ +flock \ ) if test x"$ac_cv_func_socketpair" != x"yes"; then
View file
_service:tar_scm:slang-2.3.2.tar.bz2/changes.txt -> _service:tar_scm:slang-2.3.3.tar.bz2/changes.txt
Changed
@@ -1,4 +1,187 @@ -*- mode: text; mode: fold -*- +Changes since 2.3.2 +1. src/slposdir.c: stat_file now support open file descriptors, in + addition to filenames. +2. src/sltoken.c: Ignore the \r character in multiline strings that + appear to have CRLF line terminators. (Manfred Hanke) +3. *.tm: minor documentation updates +4. src/slang.h: SLANG_VERSION_STRING was missing the "pre" prefix. +5. src/sltermin.c: Added support for TERMINFO_DIRS (based upon a patch + forwarded by Jörg Thalheim) +6. src/slarray.c: src/slarray.c: some integer overflow checks were + resulting undefined behavior (reported by Sergey) +7. modules/csv.sl: Strip leading/trailing whitespace from column names +8. src/slsmg.c,sldisply.c: Removed static buffers with sizes dependent + upon SLTT_MAX_SCREEN_ROWS/COLS in favor of dynamically allocated + ones. +9. modules/chksum-module: added CRC-8,16,32 checksums to the chksum module +10. modules/csv.sl: An error message in the form of a dollar-string + was not marked as such. +11. modules/csv.sl: Added support for empty CSV files +12. src/sltime.c: The timegm function will ignore the tm_wday and + tm_yday fields, and instead use the tm_mon and tm_mday fields. +13. modules/mkfiles/makefile.all: Added a target for chksum_crc.o for + win32/64 platforms (see change #9) +14. modules/chksum-module.c: The memset function was used with the + wrong structure size causing a buffer overflow on 32 bit systems. +15. src/terminfo/parsecaps.sl: Tweaked an auto-generated comment + produced by parsecaps.sl to produce a more deterministic build + (Ian Rogers). +16. src/slarray.c: Changed two instances of index errors to throw an + IndexError exception instead of InvalidParmError exception. +17. src/slposdir.c; The statvfs function was returning a struct with + duplicated f_bsize fields. +18. *.c: In switch statements, changed the /* drop */ comment to /* + fall through */ to avoid gcc-8 warnings. +19. modules/csv.sl: If a comment string appears at the start of a line + forming a multiline string, then treat it as part of the string. +20. slsh/lib/timestamp.sl: Added a function timestamp_parse that parses + strings such as `Thu May 14 18:05:05 2020` and returns the number + of seconds since the Unix epoch. +21. src/slregexp.c: Added \D (non-digit), \s (whitespace), and \S + (non-whitespace). +22. src/slstrops.c: Added a compiled regexp cache +23. src/slstdio.c: Added trim qualifier to the fgetlines intrinsic: + ;trim=1 ==> trim trailing whitespace + ;trim=2 ==> trim leading whitespace + ;trim=3 ==> trim leading and trailing whitespace +24. slsh/lib/timestamp.sl: When matching a regexp to a timestamp, + start with the RE that was used in the previous match. +25. Another timestamp RE tweak to pickup additional irregular forms +26. modules/csv.sl: If a CSV file has a byte-order mark (BOM), ignore it. +27. src/sldisply.c: Increased the buffer size for the SLtt_tgoto + function to allow for larger terminfo strings +28. modules/Makefile.in: Added STATS_OBJS to the clean target +29. src/slstrops.c: The is_substr function was not handling a NULL + argument +30. slsh/lib/timestamp.sl: Corrected a regular expression for a + timestamp with "Z" as the timezone. +31. modules/csv-module.c: Fields with an embedded \r were not being + properly handled. +32. src/slarray.c: Improved the speed of multi-dimensional array + indexing by about a factor of 2 +33. slsh/lib/timestamp.sl: The computation of leap days was incorrect + for some years +34. src/slang.h: Added `typedef void (*SLFVOID_STAR)(void)', which + will replace FVOID_STAR in version 3. The library code was + updated to use this. +35. slsh/lib/fswalk.sl: Added an optional callback argument to the + fswalk that is called when leaving a directory. +36. modules/termios-module.c: Avoid a potential problem with the + tcgetpgrp intrinsic in the unlikely case that sizeof(pid_t) is + larger than sizeof(int). +37. src/slarray.c: Simplified the range checking in the + linear_get_data_addr function and removed unused code. +38. Updated the copyright year +39. slsh/lib/fswalk.sl: Change #35 regression: The get_stat function + was being called with the wrong number of arguments. +40. src/slarith.c: Additional binary arithmetic optimizations involving + arrays of char and short. +41. src/slang.c,slarray.c: Added qualifier support to the array_map + function. +42. src/slang.c: Flagged the use of an uninitialized variable as soon + as it is accessed ("pushed") rather than waiting until it is used + ("popped"). Fixed a bug in slsh/lib/setfuns.sl:union that was + detected by this change. +43. src/sl-feat.h: Floating point support by the interpreter is now + required. The library has not compiled without it for a long + time. As such, this option is no longer available. +44. */test/*.sl: Surrounded regression test code that makes use of + complex numbers with `#ifexists Complex_Type' so that they run + when the interpreter is compiled without complex variable support. +45. src/slarray.c: The _pSLarray1d_push_elem needed to be exposed when + compiling the interpreter without optimization. +46. src/slarith.c,...: Rewrote the various macros used by this file to + simplify the code, permit better optimization, and easier + maintenance. Some of the loops were also unrolled. +47. src/slarray.c: Made the array bounds index checking code more + uniform for better readability. +48. src/slarray.c: The previous change introduced a bug that caused + array indexing with no (empty) indices to fail. +49. modules/chksum-module.c: When a CRC object went out of scope + without being closed, it would leave its value on the stack. +50. slsh/lib/process.sl: If the file descriptor that is used to + communicate messages from the child process back to the parent is + requested by the caller, then dup an unused one. To facilitate + testing, two additional hooks were added: exit_hook and exec_hook. +51. slsh/lib/cmdopt.sl: If a command line option is associated with a + callback function, and the value of the command line argument is + optional, pass the default value to the callback if not given on + the command line. +52. modules: Added cumulant function to the stats module; updated + regression scripts/unit tests for better code coverage; fixed a + bug in the _zlib_inflate_reset function where deflateReset was + being called instead of inflateReset. +53. slsh/lib: Updated unit/regression tests for better coverage +54. slsh/lib/print.sl: Use >= instead of > when comparing the number + of screen rows to determine if the pager should be used. +55. modules/chksum-module: Added sha224, sha256, sha384, and sha512 + algorithms kindly provided by Jakob Stierhof +56. modules/chksum-module: Added HMAC message authentication code + algorithm (Jakob Stierhof) +57. modules/mkfiles/makefile.all: Added chksum_sha2 to the non-Unix + makefile. +58. src/slgetkey.c: Use memmove instead of SLMEMCPY to avoid issues + with coping to an overlapping buffer. (William Ahern) +59. modules/pcre.sl: The options qualifier was not being properly + handled by the pcre_matches function. +60. src/_slang.h,etc: replaced the dependence of the internal + _pSLang_get_run_stack* functions, which return absolute pointers, + in favor of relative offsets. +61. src/slang.c: Made the run-time stack dynamically growable up to a + maximum configured size. +62. modules/: Documentation updates +63. src/: Added _set_bos/f_compile_hook functions to specify a + function to get called when a statement or function gets compiled. +64. src/sllimits.h: Reduced the initial stack size to a value similar + to what it was before change #61. +65. src/slarrfun.c: array_swap was returning a copy of the input array + when when swapping an array element with itself (bug reported by + Jakob Stierhof) +66. modules/csv.sl: If _csv_decode_row fails, include in the error + message the line number of the file where the error was detected +67. modules/socket-module.c: Corrected an error message for the bind + function +68. Updated the copyright year +69. Added slcov script which generates lcov-compatible code coverage + data +70. autoconf/aclocal.m4: Updated to v0.3.4.1 +71. slsh/Makefile.in: Changed the order of the linker flags to avoid a + linking problem on MacPorts (Ryan Schmidt) +72. slsh/lib/cmdopt.sl: Corrected a usage message +73. src/slposio.c: Added the flock function for the creation of + advisory locks +74. src/slcurses.h: Added 'extern "C"' to enable the file to be used + in C++ programs; also marked some variables as dynamically + exportable by using SL_EXTERN (Gisle Vanem) +75. src/slstrops.c: "%0*" was being flagged as invalid by the sprintf + function (Jakob Stierhof) +76. modules/csv.sl: When writing a CSV file with a single row, convert + any scalar data values to single element arrays. +77. src/Makefile.in, slsh/Makefile.in: Addressed some dependency + problems found by `make --shuffle` that were causing parallel + builds to fail (Sergei Trofimovich) +78. src/slarray.c: Flag out-of-range indexing of indefinite ranges + involving negative indexes, e.g., x = 1; y = x-2:; + Previousely this resulted in y = 1,1 instead of an error. +79. modules/csv.sl: Avoid indexing an empty array with a negative + index (detected by change #78) +80. src/slarray:c: #78 was flagging x:-2 as invalid instead of + producing an empty array for x=1 +81. src/slarray.c: Tweaked the handling of negative indices in + indefinite ranges such that x:-i will produce an empty array + wheneve i > length(x) +82. src/sltermin.c: Added support for so-called user-defined terminfo + extensions. In particular, if the terminfo file defines RGB=true, + then truecolor support will be enabled. +83. src/sldisply.c: The Has_True_Color variable was not defined for 32 + bit systems +84. modules/csv.sl: Improved read speed for large CSV files +85. src/test/posixio.sl: Do not test the flock function using an NFS + mounted direcory, which requires lockd to be running on the server + +{{{ Previous Versions + Changes since 2.3.1a 1. modules/stats_kendall.c: Updated to use Knight's O(NlogN) algorithm. This update was facilitating by separating out some @@ -60,8 +243,6 @@ 26. src/test/syntax.sl: The version number test required the use of isalpha and not isascii. -{{{ Previous Versions - Changes since 2.3.1 a. Some tests were failing when compiled with a compiler that defaults to using `unsigned char'. In the few places where a `signed char'
View file
_service:tar_scm:slang-2.3.2.tar.bz2/configure -> _service:tar_scm:slang-2.3.3.tar.bz2/configure
Changed
@@ -738,6 +738,7 @@ docdir oldincludedir includedir +runstatedir localstatedir sharedstatedir sysconfdir @@ -832,6 +833,7 @@ sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' +runstatedir='${localstatedir}/run' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE}' @@ -1084,6 +1086,15 @@ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; + -runstatedir | --runstatedir | --runstatedi | --runstated \ + | --runstate | --runstat | --runsta | --runst | --runs \ + | --run | --ru | --r) + ac_prev=runstatedir ;; + -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ + | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ + | --run=* | --ru=* | --r=*) + runstatedir=$ac_optarg ;; + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ @@ -1221,7 +1232,7 @@ for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ - libdir localedir mandir + libdir localedir mandir runstatedir do eval ac_val=\$$ac_var # Remove trailing slashes. @@ -1374,6 +1385,7 @@ --sysconfdir=DIR read-only single-machine data PREFIX/etc --sharedstatedir=DIR modifiable architecture-independent data PREFIX/com --localstatedir=DIR modifiable single-machine data PREFIX/var + --runstatedir=DIR modifiable per-process data LOCALSTATEDIR/run --libdir=DIR object code libraries EPREFIX/lib --includedir=DIR C header files PREFIX/include --oldincludedir=DIR C header files for non-gcc /usr/include @@ -3881,62 +3893,6 @@ -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing strerror" >&5 -$as_echo_n "checking for library containing strerror... " >&6; } -if ${ac_cv_search_strerror+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_func_search_save_LIBS=$LIBS -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char strerror (); -int -main () -{ -return strerror (); - ; - return 0; -} -_ACEOF -for ac_lib in '' cposix; do - if test -z "$ac_lib"; then - ac_res="none required" - else - ac_res=-l$ac_lib - LIBS="-l$ac_lib $ac_func_search_save_LIBS" - fi - if ac_fn_c_try_link "$LINENO"; then : - ac_cv_search_strerror=$ac_res -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext - if ${ac_cv_search_strerror+:} false; then : - break -fi -done -if ${ac_cv_search_strerror+:} false; then : - -else - ac_cv_search_strerror=no -fi -rm conftest.$ac_ext -LIBS=$ac_func_search_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_strerror" >&5 -$as_echo "$ac_cv_search_strerror" >&6; } -ac_res=$ac_cv_search_strerror -if test "$ac_res" != no; then : - test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" - -fi - cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -5293,6 +5249,7 @@ ttyname ttyname_r \ newlocale strtod_l localeconv \ statvfs \ +flock \ do : as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` @@ -6097,7 +6054,7 @@ INSTALL_ELFLIB_TARGET="install-elf-and-links" ELFLIB_BUILD_NAME="\$(ELFLIB_MAJOR_MINOR_MICRO)" -INSTALL_MODULE="\$(INSTALL_DATA)" +INSTALL_MODULE="\$(INSTALL)" SLANG_DLL_CFLAGS="" M_LIB="-lm" @@ -6105,30 +6062,30 @@ *linux*|*gnu*|k*bsd*-gnu ) DYNAMIC_LINK_FLAGS="-Wl,-export-dynamic" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fPIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fPIC" ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-O1 -Wl,--version-script,\$(VERSION_SCRIPT) -Wl,-soname,\$(ELFLIB_MAJOR)" ELF_DEP_LIBS="\$(DL_LIB) -lm -lc" CC_SHARED_FLAGS="-shared -fPIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" ;; *solaris* ) if test "$GCC" = yes then DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fPIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fPIC" ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-ztext -Wl,-h,\$(ELFLIB_MAJOR)" ELF_DEP_LIBS="\$(DL_LIB) -lm -lc" CC_SHARED_FLAGS="-G -fPIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" else DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -K PIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -K PIC" ELF_LINK="\$(CC) \$(LDFLAGS) -G -h\$(ELFLIB_MAJOR)" ELF_DEP_LIBS="\$(DL_LIB) -lm -lc" CC_SHARED_FLAGS="-G -K PIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" fi ;; # osr5 or unixware7 with current or late autoconf @@ -6137,20 +6094,20 @@ then DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fPIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fPIC" ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-h,\$(ELFLIB_MAJOR)" ELF_DEP_LIBS= CC_SHARED_FLAGS="-G -fPIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" else DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -K pic" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -K pic" # ELF_LINK="ld -G -z text -h#" ELF_LINK="\$(CC) \$(LDFLAGS) -G -z text -h\$(ELFLIB_MAJOR)" ELF_DEP_LIBS= CC_SHARED_FLAGS="-G -K pic" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" fi ;; *irix6.5* ) @@ -6161,29 +6118,29 @@ # not tested DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fPIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fPIC" ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-h,\$(ELFLIB_MAJOR)" ELF_DEP_LIBS= CC_SHARED_FLAGS="-shared -fPIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" else DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS)" # default anyhow + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS)" # default anyhow ELF_LINK="\$(CC) \$(LDFLAGS) -shared -o \$(ELFLIB_MAJOR)" ELF_DEP_LIBS= CC_SHARED_FLAGS="-shared" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" fi ;; *darwin* ) DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fno-common" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fno-common" ELF_LINK="\$(CC) \$(LDFLAGS) -dynamiclib -install_name \$(install_lib_dir)/\$(ELFLIB_MAJOR) -compatibility_version \$(ELF_MAJOR_VERSION) -current_version \$(ELF_MAJOR_VERSION).\$(ELF_MINOR_VERSION)" ELF_DEP_LIBS="\$(LDFLAGS) \$(DL_LIB)" CC_SHARED_FLAGS="-bundle -flat_namespace -undefined suppress -fno-common" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" ELFLIB="lib\$(THIS_LIB).dylib" ELFLIB_MAJOR="lib\$(THIS_LIB).\$(ELF_MAJOR_VERSION).dylib" ELFLIB_MAJOR_MINOR="lib\$(THIS_LIB).\$(ELF_MAJOR_VERSION).\$(ELF_MINOR_VERSION).dylib" @@ -6191,7 +6148,7 @@ ;; *freebsd* ) ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fPIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fPIC" #if test "X$PORTOBJFORMAT" = "Xelf" ; then # ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-soname,\$(ELFLIB_MAJOR)" #else @@ -6200,19 +6157,19 @@ ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-soname,\$(ELFLIB_MAJOR)" ELF_DEP_LIBS="\$(DL_LIB) -lm" CC_SHARED_FLAGS="-shared -fPIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" ;; *cygwin* ) DYNAMIC_LINK_FLAGS="" ELF_CC="\$(CC)" SLANG_DLL_CFLAGS="-DSLANG_DLL=1" - ELF_CFLAGS="\$(CFLAGS) -DBUILD_DLL=1" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -DBUILD_DLL=1" DLL_IMPLIB_NAME="lib\$(THIS_LIB)\$(ELFLIB_MAJOR_VERSION).dll.a" #ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-O1 -Wl,--version-script,\$(VERSION_SCRIPT) -Wl,-soname,\$(ELFLIB_MAJOR) -Wl,--out-implib=\$(DLL_IMPLIB_NAME) -Wl,-export-all-symbols -Wl,-enable-auto-import" ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-O1 -Wl,--version-script,\$(VERSION_SCRIPT) -Wl,-soname,\$(ELFLIB_MAJOR) -Wl,--out-implib=\$(DLL_IMPLIB_NAME)" ELF_DEP_LIBS="\$(DL_LIB) -lm" CC_SHARED_FLAGS="-shared -DSLANG_DLL=1" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" SLANG_LIB_FOR_MODULES="-L\$(ELFDIR) -lslang" INSTALL_MODULE="\$(INSTALL)" INSTALL_ELFLIB_TARGET="install-elf-cygwin" @@ -6226,20 +6183,20 @@ M_LIB="" DYNAMIC_LINK_FLAGS="-Wl,-export-dynamic" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fPIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fPIC" ELF_LINK="\$(CC) \$(LDFLAGS) -shared -Wl,-O1 -Wl,--version-script,\$(VERSION_SCRIPT) -Wl,-soname,\$(ELFLIB_MAJOR)" ELF_DEP_LIBS="\$(DL_LIB)" CC_SHARED_FLAGS="-shared -fPIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" ;; * ) echo "Note: ELF compiler for host_os=$host_os may be wrong" ELF_CC="\$(CC)" - ELF_CFLAGS="\$(CFLAGS) -fPIC" + ELF_CFLAGS="\$(CFLAGS) \$(CPPFLAGS) -fPIC" ELF_LINK="\$(CC) \$(LDFLAGS) -shared" ELF_DEP_LIBS="\$(DL_LIB) -lm -lc" CC_SHARED_FLAGS="-shared -fPIC" - CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS)" + CC_SHARED="\$(CC) $CC_SHARED_FLAGS \$(CFLAGS) \$(CPPFLAGS)" esac @@ -7024,7 +6981,8 @@ /usr/lib/terminfo \ /usr/share/terminfo \ /usr/share/lib/terminfo \ - /usr/local/lib/terminfo" + /usr/local/lib/terminfo \ + /etc/terminfo /lib/terminfo" TERMCAP=-ltermcap for terminfo_dir in $JD_Terminfo_Dirs
View file
_service:tar_scm:slang-2.3.2.tar.bz2/doc/text/cref.txt -> _service:tar_scm:slang-2.3.3.tar.bz2/doc/text/cref.txt
Changed
@@ -1,6 +1,6 @@ The S-Lang C Library Reference John E. Davis <www.jedsoft.org> - Nov 11, 2013 + Jul 4, 2018 ____________________________________________________________ @@ -3715,10 +3715,10 @@ The type field specifies which field of the union f should be used. If type is SLKEY_F_INTERPRET, then f.s is a string that should be - passed to the interpreter for evaluation. If type is - SLKEY_F_INTRINSIC, then f.f refers to function that should be - called. Otherwise, type is SLKEY_F_KEYSYM and f.keysym represents - the value of the keysym that is associated with the key sequence. + passed to the interpreter for evaluation. If type is SLKEY_F_IN- + TRINSIC, then f.f refers to function that should be called. Other- + wise, type is SLKEY_F_KEYSYM and f.keysym represents the value of + the keysym that is associated with the key sequence. See Also SLkm_define_keysym, SLkm_define_key
View file
_service:tar_scm:slang-2.3.2.tar.bz2/doc/text/cslang.txt -> _service:tar_scm:slang-2.3.3.tar.bz2/doc/text/cslang.txt
Changed
@@ -1,6 +1,6 @@ S-Lang Library C Programmer's Guide (v2.3.0) John E. Davis <www.jedsoft.org> - Sep 14, 2014 + Jul 4, 2018 ____________________________________________________________ @@ -241,9 +241,9 @@ If the value of mode is 1, then the library will be put in UTF-8 mode. If the value of mode is 0, then the library will be initialized with UTF-8 support disabled. If the value is -1, then the mode will deter- - mined through an OS-dependent manner, e.g., for Unix, the standard - locale mechanism will be used. The return value of this function will - be 1 if UTF-8 support was activated, or 0 if not. + mined through an OS-dependent manner, e.g., for Unix, the standard lo- + cale mechanism will be used. The return value of this function will be + 1 if UTF-8 support was activated, or 0 if not. The above function determines the UTF-8 state of the library as a whole. For some purposes it may be desirable to have more fine-grained @@ -548,8 +548,8 @@ Here name is the name of the intrinsic function that the interpreter is to give to the function. func-ptr is a pointer to the intrinsic function taking num-args and returning ret-type. The final 7 arguments - specify the argument types. For example, the intrin_exit intrinsic - described above may be added to the table using + specify the argument types. For example, the intrin_exit intrinsic de- + scribed above may be added to the table using MAKE_INTRINSIC_N("exit", intrin_exit, SLANG_VOID_TYPE, 1, SLANG_INT_TYPE, 0,0,0,0,0,0) @@ -611,8 +611,8 @@ MAKE_INTRINSIC_2("vmin", intrin_min, SLANG_DOUBLE_TYPE, SLANG_DOUBLE_TYPE, SLANG_DOUBLE_TYPE) - It is useful to extend this function to take an arbitray number of - arguments and return the lesser. Consider the following variant: + It is useful to extend this function to take an arbitray number of ar- + guments and return the lesser. Consider the following variant: double intrin_min_n (int *num_ptr) { @@ -724,8 +724,8 @@ char S256; - then it would not be possible to make it directly available to the - interpreter. However, one could create a pointer to it, i.e., + then it would not be possible to make it directly available to the in- + terpreter. However, one could create a pointer to it, i.e., char *S_Ptr = S; @@ -847,8 +847,8 @@ SLang_set_array_element (at, &i, seasonsi) - was not used. The return value from this function was also checked - because it too could also fail. + was not used. The return value from this function was also checked be- + cause it too could also fail. Finally, the array was pushed onto the interpreter's stack and then it was freed. It is important to understand why it was freed. This is @@ -1100,9 +1100,8 @@ } Name_Type; - is not supported since char name32 is not a SLANG_STRING_TYPE - object. Always keep in mind that a SLANG_STRING_TYPE object is a char - *. + is not supported since char name32 is not a SLANG_STRING_TYPE ob- + ject. Always keep in mind that a SLANG_STRING_TYPE object is a char *. 5.5.2.2. Intrinsic Structures @@ -1384,8 +1383,8 @@ and set the S-Lang global variable SLKeyBoard_Quit to a non-zero value. In addition, if the default S-Lang interrupt handler has been specified by a NULL argument to the SLang_set_abort_signal function, - the error state of the library will be set to SL_UserBreak_Error - unless the variable SLang_Ignore_User_Abort is non-zero. + the error state of the library will be set to SL_UserBreak_Error un- + less the variable SLang_Ignore_User_Abort is non-zero. The SLang_getkey function waits until input is available to be read. The SLang_input_pending function may be used to determine whether or @@ -1950,10 +1949,10 @@ void SLtt_set_mono (int obj, char *, SLtt_Char_Type attr); Only the first of these routines will be discussed briefly here. The - latter two functions allow more fine control over the object to - attribute mapping (such as assigning a ``blink'' attribute to the - object). For a more full explanation on all of these routines see the - section about the SLtt interface. + latter two functions allow more fine control over the object to attri- + bute mapping (such as assigning a ``blink'' attribute to the object). + For a more full explanation on all of these routines see the section + about the SLtt interface. The SLtt_set_color function takes four parameters. The first parameter, obj, is simply the integer of the object for which @@ -2164,9 +2163,9 @@ It is important that handlers be established for these signals while the either the SLsmg routines or the getkey routines are initialized. - The SLang_init_tty, SLang_reset_tty, SLsmg_init_smg, and - SLsmg_reset_smg functions block these signals from occurring while - they are being called. + The SLang_init_tty, SLang_reset_tty, SLsmg_init_smg, and SLsmg_re- + set_smg functions block these signals from occurring while they are + being called. Since a signal can be delivered at any time, it is important for the signal handler to call only functions that can be called from a signal @@ -2471,12 +2470,12 @@ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a - notice placed by the copyright holder saying it may be distributed - under the terms of this General Public License. The "Program", below, + notice placed by the copyright holder saying it may be distributed un- + der the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: - that is to say, a work containing the Program or a portion of it, - either verbatim or with modifications and/or translated into another + that is to say, a work containing the Program or a portion of it, ei- + ther verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you".
View file
_service:tar_scm:slang-2.3.2.tar.bz2/doc/text/slang.txt -> _service:tar_scm:slang-2.3.3.tar.bz2/doc/text/slang.txt
Changed
@@ -1,6 +1,6 @@ A Guide to the S-Lang Language (v2.3.0) John E. Davis <www.jedsoft.org> - Aug 18, 2016 + Apr 18, 2020 ____________________________________________________________ @@ -171,9 +171,8 @@ expression involving where filters the data by accepting only those energy values whose status is set to 0. The fits and histogram modules are not distributed with S-Lang but may be obtained separately-- see - http://www.jedsoft.org/slang/modules/ for links to them. For more - information about modules, see the ``Modules'' chapter in this docu- - ment. + http://www.jedsoft.org/slang/modules/ for links to them. For more in- + formation about modules, see the ``Modules'' chapter in this document. For more information about using slsh, see the chapter on ``slsh''. @@ -604,9 +603,9 @@ A = Int_Type 10; A0:9 = 7; A = Int_Type 10; A* = 7; - The second and third methods use an array of indices to index the - array A. In the second, the range of indices has been explicitly spec- - ified, whereas the third example uses a wildcard form. See chapter + The second and third methods use an array of indices to index the ar- + ray A. In the second, the range of indices has been explicitly speci- + fied, whereas the third example uses a wildcard form. See chapter ``Arrays'' for more information about array indexing. Although the examples have pertained to integer arrays, the fact is @@ -665,11 +664,11 @@ is a list of four objects, each with a different type. Like an array, the elements of a list may be accessed via an index, e.g., - x=my_list2 will result in the assignment of "foo" to x. The most - important difference between an array and a list is that an array's - size is fixed whereas a list may grow or shrink. Algorithms that - require such a data structure may execute many times faster when a - list is used instead of an array. + x=my_list2 will result in the assignment of "foo" to x. The most im- + portant difference between an array and a list is that an array's size + is fixed whereas a list may grow or shrink. Algorithms that require + such a data structure may execute many times faster when a list is + used instead of an array. 3.7. Structures and User-Defined Types @@ -718,17 +717,17 @@ bill.age = 51; One advantage of creating a new type is that array elements of such - types are automatically initialized to instances of the type. For - example, + types are automatically initialized to instances of the type. For ex- + ample, People = Person_Type 100; People0.first_name = "Bill"; People1.first_name = "Hillary"; may be used to create an array of 100 such objects and initialize the - first_name fields of the first two elements. In contrast, the form - using an anonymous would require a separate step to instantiate the - array elements: + first_name fields of the first two elements. In contrast, the form us- + ing an anonymous would require a separate step to instantiate the ar- + ray elements: People = Struct_Type 100; People0 = @person; @@ -1141,10 +1140,11 @@ 4.1.7. Array_Type, Assoc_Type, List_Type, and Struct_Type - Variables of type Array_Type, Assoc_Type, List_Type, and Struct_Type - are known as container objects. They are more complicated than the - simple data types discussed so far and each obeys a special syntax. - For these reasons they are discussed in a separate chapters. + Variables of type ``Array_Type'', ``Assoc_Type'', ``List_Type'', and + ``Struct_Type'' are known as container objects. They are more + complicated than the simple data types discussed so far and each obeys + a special syntax. For these reasons they are discussed in a separate + chapters. 4.1.8. DataType_Type Type @@ -1512,9 +1512,9 @@ return flags; } - The buffer flags object is a bitmapped quantity where the 0th bit - indicates whether or not the buffer has been modified, the first bit - indicates whether or not autosave has been enabled for the buffer, and + The buffer flags object is a bitmapped quantity where the 0th bit in- + dicates whether or not the buffer has been modified, the first bit in- + dicates whether or not autosave has been enabled for the buffer, and so on. Consider for the moment the task of determining if the buffer has been modified. This can be determined by looking at the zeroth bit: if it is 0 the buffer has not been modified, otherwise it has @@ -1594,10 +1594,10 @@ } Here the relational binary operator > forms a comparison between one - of the return values (the one at the top of the stack) and 0. In - accordance with the above rule, since read_line returns multiple val- - ues, it must occur as the left binary operand. Putting it on the - right as in + of the return values (the one at the top of the stack) and 0. In ac- + cordance with the above rule, since read_line returns multiple values, + it must occur as the left binary operand. Putting it on the right as + in while (0 < read_line (fp)) % Incorrect { @@ -1844,8 +1844,8 @@ } } - although the indentation indicates otherwise. It is important to - understand the grammar and not be seduced by the indentation! + although the indentation indicates otherwise. It is important to un- + derstand the grammar and not be seduced by the indentation! 8.3.1.3. ifnot @@ -1885,16 +1885,16 @@ orelse { 0 } { 6 } { 2 } { 3 } - returns 6 since the second block is the first to return a non-zero - result. The last two block will not get executed. + returns 6 since the second block is the first to return a non-zero re- + sult. The last two block will not get executed. The syntax for the andelse statement is: andelse {integer-expression-1} ... {integer-expression-n} Each of the blocks will be executed in turn until one of them returns - a zero value. The result of this statement is the integer value - returned by the last block executed. For example, + a zero value. The result of this statement is the integer value re- + turned by the last block executed. For example, andelse { 6 } { 2 } { 0 } { 4 } @@ -2051,12 +2051,12 @@ or-block then statement-or-block next-statement In addition to statement-or-block, its specification requires three - other expressions. When executed, the for statement evaluates init- - expression, then it tests integer-expression. If integer-expression - evaluates to zero, control passes to next-statement. Otherwise, it - executes statement-or-block as long as integer-expression evaluates to - a non-zero result. After every execution of statement-or-block, end- - expression will get evaluated. + other expressions. When executed, the for statement evaluates init-ex- + pression, then it tests integer-expression. If integer-expression + evaluates to zero, control passes to next-statement. Otherwise, it ex- + ecutes statement-or-block as long as integer-expression evaluates to a + non-zero result. After every execution of statement-or-block, end-ex- + pression will get evaluated. This statement is almost equivalent to @@ -2150,8 +2150,8 @@ Here object can be an expression that evaluates to a value. Each time through the loop the variable var will take on a value that depends - upon the data type of the object being processed. For container - objects, var will take on values of successive members of the object. + upon the data type of the object being processed. For container ob- + jects, var will take on values of successive members of the object. A simple example is @@ -2171,8 +2171,8 @@ block The allowed values of control-list will depend upon the type of con- - tainer object. For associative arrays (Assoc_Type), control-list spec- - ifies whether keys, values, or both are used. For example, + tainer object. For associative arrays (``Assoc_Type''), control-list + specifies whether keys, values, or both are used. For example, foreach k (a) using ("keys") { @@ -2180,8 +2180,8 @@ . } - results in the keys of the associative array a being successively - assigned to k. Similarly, + results in the keys of the associative array a being successively as- + signed to k. Similarly, foreach v (a) using ("values") { @@ -2379,8 +2379,8 @@ represent parameters passed to the function, and may be empty if no parameters are to be passed. The variables in the parameter-list are implicitly declared, thus, there is no need to declare them via a - variable declaration statement. In fact any attempt to do so will - result in a syntax error. + variable declaration statement. In fact any attempt to do so will re- + sult in a syntax error. The body of the function is enclosed in braces and consists of zero or more statements (statement-list). While there are no imposed limits @@ -2403,11 +2403,11 @@ Here a function add_10 has been defined, which when executed, adds 10 to its parameter. A variable b has also been declared and initialized - to zero before being passed to add_10. What will be the value of b - after the call to add_10? If S-Lang were a language that passed param- - eters by reference, the value of b would be changed to 10. However, - S-Lang always passes by value, which means that b will retain its - value during and after after the function call. + to zero before being passed to add_10. What will be the value of b af- + ter the call to add_10? If S-Lang were a language that passed parame- + ters by reference, the value of b would be changed to 10. However, S- + Lang always passes by value, which means that b will retain its value + during and after after the function call. S-Lang does provide a mechanism for simulating pass by reference via the reference operator. This is described in greater detail in the @@ -2539,8 +2539,8 @@ return (line, 0); } - This function returns either one or two values, depending upon the - return value of fgets. Such a function may be handled using: + This function returns either one or two values, depending upon the re- + turn value of fgets. Such a function may be handled using: status = read_line (fp); if (status != -1) @@ -2573,10 +2573,10 @@ The expression &b creates a reference to the variable b and it is the reference that gets passed to add_10. When the function add_10 is called, the value of the local variable a will be a reference to the - variable b. It is only by dereferencing this value that b can be - accessed and changed. So, the statement @a=@a+10 should be read as - ``add 10 to the value of the object that a references and assign the - result to the object that a references''. + variable b. It is only by dereferencing this value that b can be ac- + cessed and changed. So, the statement @a=@a+10 should be read as ``add + 10 to the value of the object that a references and assign the result + to the object that a references''. The reader familiar with C will note the similarity between references in S-Lang and pointers in C. @@ -2648,8 +2648,8 @@ For the uninitiated, this example looks as if it is destined for dis- aster. The add_10 function appears to accept zero arguments, yet it was called with a single argument. On top of that, the assignment to x - might look a bit strange. The truth is, the code presented in this - example makes perfect sense, once you realize what is happening. + might look a bit strange. The truth is, the code presented in this ex- + ample makes perfect sense, once you realize what is happening. First, consider what happens when add_10 is called with the parameter 12. Internally, 12 is pushed onto the stack and then the function @@ -2681,8 +2681,8 @@ . } - before further parsing. (The add_10 function, as defined above, is - already in this form.) With this knowledge in hand, one can write a + before further parsing. (The add_10 function, as defined above, is al- + ready in this form.) With this knowledge in hand, one can write a function that accepts a variable number of arguments. Consider the function: @@ -2957,8 +2957,8 @@ % Handle the error } - Other acceptable ways to ``do something'' with the return value - include assigning it to a dummy variable, + Other acceptable ways to ``do something'' with the return value in- + clude assigning it to a dummy variable, dummy = fputs ("good luck", fp); @@ -3109,7 +3109,7 @@ tain as many as 7 dimensions. When a numeric array is created, all its elements are initialized to zero. The initialization of other array types depend upon the data type, e.g., the elements in String_Type and - Struct_Type arrays are initialized to NULL. + ``Struct_Type'' arrays are initialized to NULL. As a concrete example, consider @@ -3147,8 +3147,8 @@ first-value : last-value : increment - where the increment is optional and defaults to 1. This creates an - array whose first element is first-value and whose successive values + where the increment is optional and defaults to 1. This creates an ar- + ray whose first element is first-value and whose successive values differ by increment. last-value sets an upper limit upon the last value of the array as described below. @@ -3220,9 +3220,9 @@ reshape (array-name, integer-array); where array-name specifies the array to be reshaped to the dimensions - given by integer-array, a 1-dimensional array of integers. It is - important to note that this does not create a new array, it simply - reshapes the existing array. Thus, + given by integer-array, a 1-dimensional array of integers. It is im- + portant to note that this does not create a new array, it simply re- + shapes the existing array. Thus, variable a = Double_Type 100; reshape (a, 10, 10); @@ -3388,8 +3388,8 @@ return s; } - Better yet is to recognize that the diagonal elements of an n by n - array are given by an index array I with elements 0, n+1, 2*n+2, ..., + Better yet is to recognize that the diagonal elements of an n by n ar- + ray are given by an index array I with elements 0, n+1, 2*n+2, ..., n*n-1, or more precisely as 0:n*n-1:n+1 @@ -3477,10 +3477,10 @@ Since the array is passed to the function by reference, there is no need to make a separate copy of the 100000 element array. As pointed - out above, this saves both execution time and memory. The other - salient feature to note is that any changes made to the elements of - the array within the function will be manifested in the array outside - the function. Of course, in this case this is a desirable side-effect. + out above, this saves both execution time and memory. The other sa- + lient feature to note is that any changes made to the elements of the + array within the function will be manifested in the array outside the + function. Of course, in this case this is a desirable side-effect. To see the downside of this representation, consider: @@ -3569,12 +3569,12 @@ awhere (a < 0.0) = 0; Here, the expression (a < 0.0) returns a boolean array whose dimen- - sions are the same size as a but whose elements are either 1 or 0, - according to whether or not the corresponding element of a is less - than zero. This array of zeros and ones is then passed to the where - function, which returns a 1-d integer array of indices that indicate - where the elements of a are less than zero. Finally, those elements of - a are set to zero. + sions are the same size as a but whose elements are either 1 or 0, ac- + cording to whether or not the corresponding element of a is less than + zero. This array of zeros and ones is then passed to the where func- + tion, which returns a 1-d integer array of indices that indicate where + the elements of a are less than zero. Finally, those elements of a are + set to zero. Consider once more the example involving the set of n quadratic equations presented above. Suppose that we wish to get rid of the @@ -3775,12 +3775,11 @@ } The most redeeming feature of the version involving the series of if - statements is that it is easy to understand. However, the version - involving the associative array has two significant advantages over - the former. Namely, the function lookup will be much faster with a - time that is independent of the item being searched, and it is exten- - sible in the sense that additional functions may be added at run-time, - e.g., + statements is that it is easy to understand. However, the version in- + volving the associative array has two significant advantages over the + former. Namely, the function lookup will be much faster with a time + that is independent of the item being searched, and it is extensible + in the sense that additional functions may be added at run-time, e.g., add_function ("bing", &bing); @@ -4103,8 +4102,8 @@ The problem with the last statement is that it is not a very natural way to express the addition of three vectors. It would be far better - to extend the action of the binary + operator to the Vector_Type - objects and then write the above sum more simply as + to extend the action of the binary + operator to the Vector_Type ob- + jects and then write the above sum more simply as V4 = V1 + V2 + V3; @@ -4209,9 +4208,9 @@ c = a + b; in isolation one can easily overlook the fact that a function such as - vector_add may be getting executed. Moreover, in cases where the - action is ambiguous such as Vector_Type*Vector_Type it may not be - clear what + vector_add may be getting executed. Moreover, in cases where the ac- + tion is ambiguous such as Vector_Type*Vector_Type it may not be clear + what c = a*b; @@ -4464,8 +4463,8 @@ throw WriteError; } - Here the throw statement has been used to generate the appropriate - exception, which in this case is either an OpenError exception or a + Here the throw statement has been used to generate the appropriate ex- + ception, which in this case is either an OpenError exception or a WriteError exception. Since the function now returns nothing (no error code), it may be called as @@ -4648,8 +4647,8 @@ In this case, the value of the message field was assigned a default value. The reason that the object field is NULL is that no object was - specified when the exception was generated. In order to throw an - object, a more complex form of throw statement must be used: + specified when the exception was generated. In order to throw an ob- + ject, a more complex form of throw statement must be used: throw exception-name , message , object @@ -4683,10 +4682,10 @@ catch OSError, RunTimeError: - The last clause of a try-statement is the finally-block, which is - optional and is introduced using the finally keyword. If the try- - statement contains no catch-clauses, then it must specify a finally- - clause, otherwise a syntax error will result. + The last clause of a try-statement is the finally-block, which is op- + tional and is introduced using the finally keyword. If the try-state- + ment contains no catch-clauses, then it must specify a finally-clause, + otherwise a syntax error will result. If the finally-clause is present, then its corresponding statements will be executed regardless of whether an exception occurs. If an @@ -4753,9 +4752,9 @@ new_exception (exception-name, baseclass, description); The exception-name is the name of the exception, baseclass represents - the node in the exception hierarchy where it is to be placed, and - description is a string that provides a brief description of the - exception. + the node in the exception hierarchy where it is to be placed, and de- + scription is a string that provides a brief description of the excep- + tion. For example, suppose that you are writing some code that processes numbers stored in a binary format. In particular, assume that the @@ -4835,8 +4834,8 @@ . y = gsl->zeta(x); - This form requires that the module's symbols be accessed via the - namespace qualifier "gsl->". + This form requires that the module's symbols be accessed via the name- + space qualifier "gsl->". 18. File Input/Output @@ -4963,8 +4962,8 @@ while (-1 != fread (&line, Char_Type, 1024, fp)) count += length (line); - The fread function requires two additional arguments: the type of - object to read (Char_Type in the case), and the number of such objects + The fread function requires two additional arguments: the type of ob- + ject to read (Char_Type in the case), and the number of such objects to be read. The function returns the number of objects actually read in the form of an array of the specified type, or -1 upon failure. @@ -5038,8 +5037,8 @@ and combines the objects in the item-list according to format-string into a binary string and returns the result. Likewise, the unpack - function may be used to convert a binary string into separate data - objects: + function may be used to convert a binary string into separate data ob- + jects: (variable-list) = unpack (format-string, binary-string); @@ -5270,8 +5269,8 @@ } The first line of the script Unix-specific and should be familiar to - Unix users. Typically, the code before slsh_main will load any - required modules or packages, and define other functions to be used by + Unix users. Typically, the code before slsh_main will load any re- + quired modules or packages, and define other functions to be used by the script. Although the use of slsh_main is not required, its use is strongly @@ -5812,8 +5811,8 @@ "\(\<a-zA-Z+\>\) +\1\>" which matches any word repeated consecutively. Note how the grouping - operators \( and \) are used to define the text matched by the - enclosed regular expression, and then subsequently referred to \1. + operators \( and \) are used to define the text matched by the en- + closed regular expression, and then subsequently referred to \1. Finally, remember that when used in string literals either in the S- Lang language or in the C language, care must be taken to "double-up" @@ -5838,9 +5837,9 @@ matches "xxx@abc@silly@abc@yyy", where the pattern \1 matches the text enclosed by the \( and \) expressions. However, in the current imple- - mentation, the grouping operators are not used to group regular - expressions to form a single regular expression. Thus expression such - as "\(hello\)*" is not a pattern to match zero or more occurrences of + mentation, the grouping operators are not used to group regular ex- + pressions to form a single regular expression. Thus expression such as + "\(hello\)*" is not a pattern to match zero or more occurrences of "hello" as it is in e.g., egrep. One question that comes up from time to time is why doesn't S-Lang @@ -6279,8 +6278,8 @@ cleanup_after_error (); } - And code using _clear_error in conjunction with EXE- - CUTE_ERROR_BLOCK: + And code using _clear_error in conjunction with EXECUTE_ER- + ROR_BLOCK: ERROR_BLOCK { cleanup_after_error (); _clear_error ();} do_something (); @@ -6323,8 +6322,8 @@ nread = fread (&str, Char_Type, num_wanted, fp) - will no longer result in str being a BString_Type if nread > 1. - Instead, str will now become a Char_Typenread object. In order to + will no longer result in str being a BString_Type if nread > 1. In- + stead, str will now become a Char_Typenread object. In order to read a specified number of bytes from a file in the form of a string, use the fread_bytes function: @@ -6431,12 +6430,12 @@ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a - notice placed by the copyright holder saying it may be distributed - under the terms of this General Public License. The "Program", below, + notice placed by the copyright holder saying it may be distributed un- + der the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: - that is to say, a work containing the Program or a portion of it, - either verbatim or with modifications and/or translated into another + that is to say, a work containing the Program or a portion of it, ei- + ther verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you".
View file
_service:tar_scm:slang-2.3.2.tar.bz2/doc/text/slangfun.txt -> _service:tar_scm:slang-2.3.3.tar.bz2/doc/text/slangfun.txt
Changed
@@ -980,7 +980,7 @@ SEE ALSO - where, wherelast, wherfirstmin, wherfirstmax, wherefirst_eq + where, wherelast, wherefirstmin, wherefirstmax, wherefirst_eq -------------------------------------------------------------- @@ -1579,6 +1579,32 @@ -------------------------------------------------------------- +Array_Type + + SYNOPSIS + An array type + + DESCRIPTION + Arrays up to 7 dimensions are supported. The `{i,j,...,k}` element + of an array `A' may be indexed using `Ai,j,..k'. + + The `length' function may be used to obtain the total number of + elements in the array. The shape, type, and other properties of an + array may obtained using the `array_shape' and + `array_info' functions. + + The `foreach' construct may be used with arrays via the + following construct: + + foreach v (A) {...} + + In all the above forms, the loop is over all elements `v' of the array. + + SEE ALSO + List_Type, Struct_Type, Assoc_Type + +-------------------------------------------------------------- + Assoc_Type SYNOPSIS @@ -3663,6 +3689,41 @@ -------------------------------------------------------------- +_Inf + + SYNOPSIS + IEEE Infinity + + USAGE + Double_Type _Inf + + DESCRIPTION +The value of this variable is an IEEE double precision positive infinity. + + SEE ALSO + isinf, isnan, finite, _NaN + +_NaN + + SYNOPSIS + IEEE Not-a-Number + + USAGE + Double_Type _NaN + + DESCRIPTION +The value of this variable is a non-signalling IEEE double precision +NaN. + + NOTES +An IEEE NaN has some peculiar properties that limits how it should be +used. For example, an IEEE NaN is not equal to itself and expressions +such as `x == _NaN' will always be false. To test if a number is +a NaN, use the `isnan' function. + + SEE ALSO + isinf, isnan, finite, _Inf + abs SYNOPSIS @@ -6071,6 +6132,51 @@ -------------------------------------------------------------- +flock + + SYNOPSIS + control an advisory lock on a file + + USAGE + Int_Type flock (File_Type|FD_Type fd, Int_Type op) + + DESCRIPTION + This function may be used to apply or remove an advisory lock to the + open file represented by the file descriptor `fd'. The + `op' argument controls the use of the lock via one of + the following values: + + LOCK_SH : Add a shared lock. Such locks may be shared by multiple + processes + LOCK_EX : Add an exclusive lock. This type of lock is not shared + with other processes + LOCK_UN : Remove the lock added by the current process + + If another process currently has the file locked in an incompatible + way, the call to `flock' will block until that process has + removed the lock. To preveent such blocking, the `LOCK_NB' + flag may be ``ored'' with the locking operation, e.g., + `LOCK_EX|LOCK_NB'. + + The advisory locks are inherited through any operation that + duplicates or inherits the file descriptor, e.g., the `dup2' or + `fork' functions. + + The functions returns 0 upon sucess and -1 upon error. Check the + value of the `errno' variable for the reason for failure. Note + that if the `LOCK_NB' flag is used and the file is already + locked in an incompatible way, then the function will fail and set + `errno' to `EWOULDBLOCK'. + + NOTES + See the system documentation for additional semantics associated + with this function. + + SEE ALSO + open, fopen, fdopen + +-------------------------------------------------------------- + getegid SYNOPSIS @@ -8075,6 +8181,13 @@ file. If the file is empty, an empty string array will be returned. The function returns NULL upon error. + QUALIFIERS + The `trim' qualifier may be used remove leading or trailing + whitespace from the returned lines. If `trim' is 1, trailing + whitespace will be removed. If its value is 2, then leading + whitespace will be removed. If `trim' is 3, then both leading + and trailing whitespace will be removed. + EXAMPLE The following function returns the number of lines in a file: @@ -10278,6 +10391,26 @@ -------------------------------------------------------------- +__add_destroy + + SYNOPSIS + Add a destroy callback function to a user-defined type + + USAGE + __add_destroy(DataType_Type user_type, Ref_Type callback_func) + + DESCRIPTION + The `__add_destroy' function adds a callback function to a + user-defined type such that it will get called prior to deleting an + instance of the user-defined type. Just prior to deleting the + object, the object will be passed to the callback function. The + callback function should return nothing. + + SEE ALSO + __add_unary, __add_binary + +-------------------------------------------------------------- + __add_string SYNOPSIS @@ -11089,7 +11222,7 @@ A better name should have been chosen for this function. SEE ALSO - integer, string, typedef, sprintf, pack + integer, string, sprintf, pack --------------------------------------------------------------
View file
_service:tar_scm:slang-2.3.2.tar.bz2/doc/tm/rtl/array.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/doc/tm/rtl/array.tm
Changed
@@ -739,7 +739,7 @@ return NULL; } #v- -\seealso{where, wherelast, wherfirstmin, wherfirstmax, wherefirst_eq} +\seealso{where, wherelast, wherefirstmin, wherefirstmax, wherefirst_eq} \done \function{wherefirst_eq,
View file
_service:tar_scm:slang-2.3.2.tar.bz2/doc/tm/rtl/datatype.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/doc/tm/rtl/datatype.tm
Changed
@@ -1,3 +1,23 @@ +\datatype{Array_Type} +\synopsis{An array type} +\description + Arrays up to 7 dimensions are supported. The `{i,j,...,k}` element + of an array \exmp{A} may be indexed using \exmp{Ai,j,..k}. + + The \ifun{length} function may be used to obtain the total number of + elements in the array. The shape, type, and other properties of an + array may obtained using the \ifun{array_shape} and + \ifun{array_info} functions. + + The \var{foreach} construct may be used with arrays via the + following construct: +#v+ + foreach v (A) {...} +#v- + In all the above forms, the loop is over all elements \exmp{v} of the array. +\seealso{List_Type, Struct_Type, Assoc_Type} +\done + \datatype{Assoc_Type} \synopsis{An associative array or hash type} \description
View file
_service:tar_scm:slang-2.3.2.tar.bz2/doc/tm/rtl/math.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/doc/tm/rtl/math.tm
Changed
@@ -1,3 +1,23 @@ +\variable{_Inf} +\synopsis{IEEE Infinity} +\usage{Double_Type _Inf} +\description +The value of this variable is an IEEE double precision positive infinity. +\seealso{isinf, isnan, finite, _NaN} + +\variable{_NaN} +\synopsis{IEEE Not-a-Number} +\usage{Double_Type _NaN} +\description +The value of this variable is a non-signalling IEEE double precision +NaN. +\notes +An IEEE NaN has some peculiar properties that limits how it should be +used. For example, an IEEE NaN is not equal to itself and expressions +such as \exmp{x == _NaN} will always be false. To test if a number is +a NaN, use the \ifun{isnan} function. +\seealso{isinf, isnan, finite, _Inf} + \function{abs} \synopsis{Compute the absolute value of a number} \usage{y = abs(x)}
View file
_service:tar_scm:slang-2.3.2.tar.bz2/doc/tm/rtl/posix.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/doc/tm/rtl/posix.tm
Changed
@@ -1,3 +1,40 @@ + +\function{flock} +\synopsis{control an advisory lock on a file} +\usage{Int_Type flock (File_Type|FD_Type fd, Int_Type op)} +\description + This function may be used to apply or remove an advisory lock to the + open file represented by the file descriptor \exmp{fd}. The + \exmp{op} argument controls the use of the lock via one of + the following values: +#v+ + LOCK_SH : Add a shared lock. Such locks may be shared by multiple + processes + LOCK_EX : Add an exclusive lock. This type of lock is not shared + with other processes + LOCK_UN : Remove the lock added by the current process +#v- + If another process currently has the file locked in an incompatible + way, the call to \ifun{flock} will block until that process has + removed the lock. To preveent such blocking, the \ivar{LOCK_NB} + flag may be ``ored'' with the locking operation, e.g., + \exmp{LOCK_EX|LOCK_NB}. + + The advisory locks are inherited through any operation that + duplicates or inherits the file descriptor, e.g., the \ifun{dup2} or + \ifun{fork} functions. + + The functions returns 0 upon sucess and -1 upon error. Check the + value of the \ivar{errno} variable for the reason for failure. Note + that if the \ivar{LOCK_NB} flag is used and the file is already + locked in an incompatible way, then the function will fail and set + \ivar{errno} to \exmp{EWOULDBLOCK}. +\notes + See the system documentation for additional semantics associated + with this function. +\seealso{open, fopen, fdopen} +\done + \function{getegid} \synopsis{Get the effective group id of the current process} \usage{Int_Type getegid ()}
View file
_service:tar_scm:slang-2.3.2.tar.bz2/doc/tm/rtl/stdio.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/doc/tm/rtl/stdio.tm
Changed
@@ -169,6 +169,12 @@ unspecified, the function will return the rest of the lines in the file. If the file is empty, an empty string array will be returned. The function returns \NULL upon error. +\qualifiers + The \exmp{trim} qualifier may be used remove leading or trailing + whitespace from the returned lines. If \exmp{trim} is 1, trailing + whitespace will be removed. If its value is 2, then leading + whitespace will be removed. If \exmp{trim} is 3, then both leading + and trailing whitespace will be removed. \example The following function returns the number of lines in a file: #v+
View file
_service:tar_scm:slang-2.3.2.tar.bz2/doc/tm/rtl/struct.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/doc/tm/rtl/struct.tm
Changed
@@ -57,6 +57,19 @@ \seealso{__add_unary, __add_string, __add_destroy} \done + +\function{__add_destroy} +\synopsis{Add a destroy callback function to a user-defined type} +\usage{__add_destroy(DataType_Type user_type, Ref_Type callback_func)} +\description + The \ifun{__add_destroy} function adds a callback function to a + user-defined type such that it will get called prior to deleting an + instance of the user-defined type. Just prior to deleting the + object, the object will be passed to the callback function. The + callback function should return nothing. +\seealso{__add_unary, __add_binary} +\done + \function{__add_string} \synopsis{Specify a string representation for a user-defined type} \usage{__add_string (DataType_Type user_type, Ref_Type func)}
View file
_service:tar_scm:slang-2.3.2.tar.bz2/doc/tm/rtl/type.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/doc/tm/rtl/type.tm
Changed
@@ -95,7 +95,7 @@ whose value is that of \exmp{-c&0xFF}. \notes A better name should have been chosen for this function. -\seealso{integer, string, typedef, sprintf, pack} +\seealso{integer, string, sprintf, pack} \done \function{define_case}
View file
_service:tar_scm:slang-2.3.2.tar.bz2/doc/tm/slang.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/doc/tm/slang.tm
Changed
@@ -10,6 +10,8 @@ #d sectref#1 the section on \ref{$1} #d chapterref#1 the chapter on \ref{$1} +#d ref_dtype#1 <tt><ref id="label-$1" name="$1"></tt> +#d labeled_dtype#1 <label id="label-$1"> #d documentstyle book #%}}} @@ -1169,8 +1171,8 @@ \sect1{Array_Type, Assoc_Type, List_Type, and Struct_Type} - Variables of type \dtype{Array_Type}, \dtype{Assoc_Type}, - \dtype{List_Type}, and \dtype{Struct_Type} are known as + Variables of type \ref_dtype{Array_Type}, \ref_dtype{Assoc_Type}, + \ref_dtype{List_Type}, and \ref_dtype{Struct_Type} are known as \em{container objects}. They are more complicated than the simple data types discussed so far and each obeys a special syntax. For these reasons they are discussed in a separate chapters. @@ -2308,7 +2310,7 @@ \em{statement-or-block} \end{tscreen} The allowed values of \em{control-list} will depend upon the type - of container object. For associative arrays (\var{Assoc_Type}), + of container object. For associative arrays (\ref_dtype{Assoc_Type}), \em{control-list} specifies whether \em{keys}, \em{values}, or both are used. For example, #v+ @@ -3300,6 +3302,7 @@ #%}}} \labeled_chapter{Arrays} #%{{{ +\labeled_dtype{Array_Type} An array is a container object that can contain many values of one data type. Arrays are very useful objects and are indispensable @@ -3320,7 +3323,7 @@ permits arrays to contain as many as 7 dimensions. When a numeric array is created, all its elements are initialized to zero. The initialization of other array types depend upon the data type, - e.g., the elements in \var{String_Type} and \var{Struct_Type} arrays are + e.g., the elements in \var{String_Type} and \ref_dtype{Struct_Type} arrays are initialized to \NULL. As a concrete example, consider @@ -3934,6 +3937,7 @@ #%}}} \chapter{Associative Arrays} #%{{{ +\labeled_dtype{Assoc_Type} An associative array differs from an ordinary array in the sense that its size is not fixed and that it is indexed by a string, called @@ -4054,6 +4058,8 @@ \chapter{Structures and User-Defined Types} #%{{{ +\labeled_dtype{Struct_Type} + A \em{structure} is a heterogeneous container object, i.e., it is an object with elements whose values do not have to be of the same data type. The elements or fields of a structure are named, and @@ -4537,6 +4543,7 @@ #%}}} \chapter{Lists} #%{{{ +\labeled_dtype{List_Type} Sometimes it is desirable to utilize an object that has many of the properties of an array, but can also easily grow or shrink upon
View file
_service:tar_scm:slang-2.3.2.tar.bz2/doc/tm/slangfun.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/doc/tm/slangfun.tm
Changed
@@ -5,7 +5,8 @@ #i local.tm -#d function#1 \sect{<bf>$1</bf>\label{$1}}<descrip> +#d function#1 \sect{\linuxdoc_list_to_label{$1}}<descrip> +#% #d function#1 \sect{<bf>$1</bf>\label{$1}}<descrip> #d variable#1 \sect{<bf>$1</bf>\label{$1}}<descrip> #d datatype#1 \sect{<bf>$1</bf>\label{$1}}<descrip>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/Makefile.in -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/Makefile.in
Changed
@@ -11,7 +11,7 @@ test_varray.sl test_socket.sl test_rand.sl test_fork.sl test_csv.sl \ test_base64.sl test_chksum.sl test_hist.sl test_stats.sl test_json.sl # -CHKSUM_OBJS = chksum-module.o chksum_md5.o chksum_sha1.o +CHKSUM_OBJS = chksum-module.o chksum_md5.o chksum_sha1.o chksum_sha2.o chksum_crc.o STATS_OBJS = stats-module.o stats_kendall.o # --------------------------------------------------------------------------- CC = @CC@ @@ -153,6 +153,10 @@ $(COMPILE_CMD) -c $(SRCDIR)/chksum_md5.c chksum_sha1.o: $(SRCDIR)/chksum_sha1.c $(SRCDIR)/chksum.h $(COMPILE_CMD) -c $(SRCDIR)/chksum_sha1.c +chksum_sha2.o: $(SRCDIR)/chksum_sha2.c $(SRCDIR)/chksum.h + $(COMPILE_CMD) -c $(SRCDIR)/chksum_sha2.c +chksum_crc.o: $(SRCDIR)/chksum_crc.c $(SRCDIR)/chksum.h + $(COMPILE_CMD) -c $(SRCDIR)/chksum_crc.c # histogram-module.so: $(SRCDIR)/histogram-module.c $(SRCDIR)/histogram-module.inc $(COMPILE_CMD) $(SRCDIR)/histogram-module.c -o histogram-module.so $(LIBS) @@ -213,7 +217,7 @@ cd test; ./runtests.sh $$test_scripts clean: -/bin/rm -f $(OBJDIR_TSTAMP) - -cd $(OBJDIR) && /bin/rm -f $(MODULES) $(CHKSUM_OBJS) + -cd $(OBJDIR) && /bin/rm -f $(MODULES) $(CHKSUM_OBJS) $(STATS_OBJS) -/bin/rm -f *~ */*~ distclean: clean -/bin/rm -f Makefile $(OBJDIR)/Makefile $(CONFIG_H)
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/base64-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/base64-module.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2014-2017,2018 John E. Davis +Copyright (C) 2014-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/chksum-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/chksum-module.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2014-2017,2018 John E. Davis +Copyright (C) 2014-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -48,6 +48,13 @@ { {"md5", _pSLchksum_md5_new}, {"sha1", _pSLchksum_sha1_new}, + {"crc8", _pSLchksum_crc8_new}, /* qualifiers: poly, seed, refin, refout, xorout */ + {"crc16", _pSLchksum_crc16_new}, /* qualifiers: poly, seed, ... */ + {"crc32", _pSLchksum_crc32_new}, /* qualifiers: poly, seed, ...*/ + {"sha224", _pSLchksum_sha256_new}, + {"sha256", _pSLchksum_sha256_new}, + {"sha384", _pSLchksum_sha512_new}, + {"sha512", _pSLchksum_sha512_new}, {NULL, NULL} }; @@ -87,7 +94,7 @@ return; } if (obj->c != NULL) - (void) obj->c->close (obj->c, NULL); + (void) obj->c->close (obj->c, NULL, 1); SLfree ((char *)obj); } @@ -103,7 +110,7 @@ obj = (Chksum_Object_Type *)SLmalloc (sizeof (Chksum_Object_Type)); if (obj == NULL) return; - memset ((char *)obj, 0, sizeof(SLChksum_Type)); + memset ((char *)obj, 0, sizeof(Chksum_Object_Type)); obj->numrefs = 1; if (NULL == (obj->c = t->create (name))) @@ -148,46 +155,95 @@ (void) SLang_push_null (); return; } + obj->c = NULL; + + if (c->close_will_push) + { + (void) c->close (c, NULL, 0); + return; + } digest_len = c->digest_len; if (NULL == (digest = (unsigned char *)SLmalloc(2*digest_len+1))) return; - if (-1 == c->close (c, digest)) + if (-1 == c->close (c, digest, 0)) { SLfree ((char *)digest); return; } - obj->c = NULL; - hexify_string (digest, digest_len); + if (SLang_qualifier_exists("binary")) /* allow to return the digest as BString */ + { + SLang_BString_Type *bstr; + if (NULL == (bstr = SLbstring_create_malloced(digest, digest_len, 0))) + { + SLang_push_null(); + return; + } + (void) SLang_push_bstring(bstr); + SLbstring_free(bstr); + return; + } + hexify_string (digest, digest_len); (void) SLang_push_malloced_string ((char *)digest); } +static SLChksum_Type *get_chksum_type_from_obj (Chksum_Object_Type *obj) +{ + SLChksum_Type *c = obj->c; + + if (c == NULL) + SLang_verror (SL_InvalidParm_Error, "Checksum object is invalid"); + + return c; +} + static void chksum_accumulate (Chksum_Object_Type *obj, SLang_BString_Type *b) { SLChksum_Type *c; SLstrlen_Type len; unsigned char *s; - if (NULL == (c = obj->c)) - { - SLang_verror (SL_InvalidParm_Error, "Checksum object is invalid"); - return; - } + if (NULL == (c = get_chksum_type_from_obj (obj))) + return; + if (NULL == (s = SLbstring_get_pointer (b, &len))) return; (void) c->accumulate (c, s, len); } +static unsigned int chksum_buffer_size (Chksum_Object_Type *obj) +{ + SLChksum_Type *c; + + if (NULL == (c = get_chksum_type_from_obj (obj))) + return 0; + + return c->buffer_size; +} + +static unsigned int chksum_digest_length (Chksum_Object_Type *obj) +{ + SLChksum_Type *c; + + if (NULL == (c = get_chksum_type_from_obj (obj))) + return 0; + + return c->digest_len; +} + + #define DUMMY_CHKSUM_TYPE ((unsigned int)-1) static SLang_Intrin_Fun_Type Intrinsics = { MAKE_INTRINSIC_1 ("_chksum_new", chksum_new, SLANG_VOID_TYPE, SLANG_STRING_TYPE), MAKE_INTRINSIC_2 ("_chksum_accumulate", chksum_accumulate, SLANG_VOID_TYPE, DUMMY_CHKSUM_TYPE, SLANG_BSTRING_TYPE), MAKE_INTRINSIC_1 ("_chksum_close", chksum_close, SLANG_VOID_TYPE, DUMMY_CHKSUM_TYPE), + MAKE_INTRINSIC_1 ("_chksum_digest_length", chksum_digest_length, SLANG_UINT_TYPE, DUMMY_CHKSUM_TYPE), + MAKE_INTRINSIC_1 ("_chksum_buffer_size", chksum_buffer_size, SLANG_UINT_TYPE, DUMMY_CHKSUM_TYPE), SLANG_END_INTRIN_FUN_TABLE };
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/chksum.h -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/chksum.h
Changed
@@ -5,11 +5,13 @@ { int (*accumulate)(struct SLChksum_Type *, unsigned char *, unsigned int); - /* compute the digest and delete the object. If the digest parameter is - * NULL, just delete the object + /* compute the digest and delete the object. If the last argument is + * non-zero, just delete the object. */ - int (*close)(struct SLChksum_Type *, unsigned char *); + int (*close)(struct SLChksum_Type *, unsigned char *, int); unsigned int digest_len; /* set by open */ + unsigned int buffer_size; /* the buffer length */ + int close_will_push; /* if non-zero, the close method will push the result */ #ifdef CHKSUM_TYPE_PRIVATE_FIELDS /* private data */ CHKSUM_TYPE_PRIVATE_FIELDS @@ -19,5 +21,10 @@ extern SLChksum_Type *_pSLchksum_sha1_new (char *name); extern SLChksum_Type *_pSLchksum_md5_new (char *name); +extern SLChksum_Type *_pSLchksum_crc8_new (char *name); +extern SLChksum_Type *_pSLchksum_crc16_new (char *name); +extern SLChksum_Type *_pSLchksum_crc32_new (char *name); +extern SLChksum_Type *_pSLchksum_sha256_new (char *name); +extern SLChksum_Type *_pSLchksum_sha512_new (char *name); #endif
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/chksum.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/chksum.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for @@ -6,55 +6,154 @@ %--------------------------------------------------------------------------- import ("chksum"); -private define chksum_accumulate (c, str) +private variable CRC8_Map = Assoc_TypeStruct_Type; +define chksum_add_crc8_subtype (subtype) { - _chksum_accumulate (c.obj, str); + subtype = strtrans(subtype, "-_", ""); + CRC8_Mapstrlow(subtype) = @__qualifiers; } -private define chksum_close (c) +chksum_add_crc8_subtype(""; poly=0xD5, seed=0x00, refin=0, refout=0, xorout=0x00); +chksum_add_crc8_subtype("dvb-s2"; poly=0xD5, seed=0x00, refin=0, refout=0, xorout=0x00); +chksum_add_crc8_subtype("cdma2000"; poly=0x9B, seed=0xFF, refin=0, refout=0, xorout=0x00); +chksum_add_crc8_subtype("darc"; poly=0x39, seed=0x00, refin=1, refout=1, xorout=0x00); +chksum_add_crc8_subtype("ebu"; poly=0x1D, seed=0xFF, refin=1, refout=1, xorout=0x00); +chksum_add_crc8_subtype("i-code"; poly=0x1D, seed=0xFD, refin=0, refout=0, xorout=0x00); +chksum_add_crc8_subtype("itu"; poly=0x07, seed=0x00, refin=0, refout=0, xorout=0x55); +chksum_add_crc8_subtype("maxim"; poly=0x31, seed=0x00, refin=1, refout=1, xorout=0x00); +chksum_add_crc8_subtype("rohc"; poly=0x07, seed=0xFF, refin=1, refout=1, xorout=0x00); +chksum_add_crc8_subtype("wcdma"; poly=0x9B, seed=0x00, refin=1, refout=1, xorout=0x00); + +private variable CRC16_Map = Assoc_TypeStruct_Type; +define chksum_add_crc16_subtype (subtype) { - variable chksum = _chksum_close (c.obj); - c.obj = NULL; - return chksum; + subtype = strtrans(subtype, "-_", ""); + CRC16_Mapstrlow(subtype) = @__qualifiers; } -define chksum_new (name) +chksum_add_crc16_subtype(""; poly=0x1021U, seed=0xFFFFU, refin=0, refout=0, xorout=0x0000U); +chksum_add_crc16_subtype("ccitt-0"; poly=0x1021U, seed=0xFFFFU, refin=0, refout=0, xorout=0x0000U); +chksum_add_crc16_subtype("ARC"; poly=0x8005U, seed=0x0000U, refin=1, refout=1, xorout=0x0000U); +chksum_add_crc16_subtype("AUG-CCITT"; poly=0x1021U, seed=0x1D0FU, refin=0, refout=0, xorout=0x0000U); +chksum_add_crc16_subtype("BUYPASS"; poly=0x8005U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U); +chksum_add_crc16_subtype("CDMA2000"; poly=0xC867U, seed=0xFFFFU, refin=0, refout=0, xorout=0x0000U); +chksum_add_crc16_subtype("DDS-110"; poly=0x8005U, seed=0x800DU, refin=0, refout=0, xorout=0x0000U); +chksum_add_crc16_subtype("DECT-R"; poly=0x0589U, seed=0x0000U, refin=0, refout=0, xorout=0x0001U); +chksum_add_crc16_subtype("DECT-X"; poly=0x0589U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U); +chksum_add_crc16_subtype("DNP"; poly=0x3D65U, seed=0x0000U, refin=1, refout=1, xorout=0xFFFFU); +chksum_add_crc16_subtype("EN-13757"; poly=0x3D65U, seed=0x0000U, refin=0, refout=0, xorout=0xFFFFU); +chksum_add_crc16_subtype("GENIBUS"; poly=0x1021U, seed=0xFFFFU, refin=0, refout=0, xorout=0xFFFFU); +chksum_add_crc16_subtype("MAXIM"; poly=0x8005U, seed=0x0000U, refin=1, refout=1, xorout=0xFFFFU); +chksum_add_crc16_subtype("MCRF4XX"; poly=0x1021U, seed=0xFFFFU, refin=1, refout=1, xorout=0x0000U); +chksum_add_crc16_subtype("RIELLO"; poly=0x1021U, seed=0xB2AAU, refin=1, refout=1, xorout=0x0000U); +chksum_add_crc16_subtype("T10-DIF"; poly=0x8BB7U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U); +chksum_add_crc16_subtype("TELEDISK"; poly=0xA097U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U); +chksum_add_crc16_subtype("TMS37157"; poly=0x1021U, seed=0x89ECU, refin=1, refout=1, xorout=0x0000U); +chksum_add_crc16_subtype("USB"; poly=0x8005U, seed=0xFFFFU, refin=1, refout=1, xorout=0xFFFFU); +chksum_add_crc16_subtype("A"; poly=0x1021U, seed=0xC6C6U, refin=1, refout=1, xorout=0x0000U); +chksum_add_crc16_subtype("KERMIT"; poly=0x1021U, seed=0x0000U, refin=1, refout=1, xorout=0x0000U); +chksum_add_crc16_subtype("MODBUS"; poly=0x8005U, seed=0xFFFFU, refin=1, refout=1, xorout=0x0000U); +chksum_add_crc16_subtype("X-25"; poly=0x1021U, seed=0xFFFFU, refin=1, refout=1, xorout=0xFFFFU); +chksum_add_crc16_subtype("XMODEM"; poly=0x1021U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U); + +private variable CRC32_Map = Assoc_TypeStruct_Type; +define chksum_add_crc32_subtype (subtype) { - return struct + subtype = strtrans(subtype, "-_", ""); + CRC32_Mapstrlow(subtype) = @__qualifiers; +} + +chksum_add_crc32_subtype(""; poly=0x04C11DB7U, seed=0xFFFFFFFFU, refin=1, refout=1, xorout=0xFFFFFFFFU); +chksum_add_crc32_subtype("BZIP2"; poly=0x04C11DB7U, seed=0xFFFFFFFFU, refin=0, refout=0, xorout=0xFFFFFFFFU); +chksum_add_crc32_subtype("C"; poly=0x1EDC6F41U, seed=0xFFFFFFFFU, refin=1, refout=1, xorout=0xFFFFFFFFU); +chksum_add_crc32_subtype("D"; poly=0xA833982BU, seed=0xFFFFFFFFU, refin=1, refout=1, xorout=0xFFFFFFFFU); +chksum_add_crc32_subtype("MPEG-2"; poly=0x04C11DB7U, seed=0xFFFFFFFFU, refin=0, refout=0, xorout=0x00000000U); +chksum_add_crc32_subtype("POSIX"; poly=0x04C11DB7U, seed=0x00000000U, refin=0, refout=0, xorout=0xFFFFFFFFU); +chksum_add_crc32_subtype("Q"; poly=0x814141ABU, seed=0x00000000U, refin=0, refout=0, xorout=0x00000000U); +chksum_add_crc32_subtype("JAMCRC"; poly=0x04C11DB7U, seed=0xFFFFFFFFU, refin=1, refout=1, xorout=0x00000000U); +chksum_add_crc32_subtype("XFER"; poly=0x000000AFU, seed=0x00000000U, refin=0, refout=0, xorout=0x00000000U); + +private define parse_name (name) +{ + name = strlow (name); + variable q = __qualifiers; + variable subtype = qualifier ("type", NULL); + variable words = strchop (name, '/', 0); + + % Convert crc-8 to crc8, i-code to icode, etc + name = strtrans(words0, "-_", ""); + if (strncmp(name, "crc", 3)) + return name, q; + + if (length (words) > 1) + subtype = words1; + else if (subtype == NULL) { - obj = _chksum_new (name), - accumulate = &chksum_accumulate, - close = &chksum_close, - name = name, - }; + if (q != NULL) + return name, q; + subtype = ""; + } + + subtype = strtrans (strlow (subtype), "-_", ""); + variable map = NULL; + + if (name == "crc8") + map = CRC8_Map; + else if (name == "crc16") + map = CRC16_Map; + else if (name == "crc32") + map = CRC32_Map; + + if ((map != NULL) + && assoc_key_exists (map, subtype)) + return name, mapsubtype; + + throw UndefinedNameError, "Unknown $name type: $subtype"$; } -define md5sum_new () +private define chksum_accumulate (c, str) { - return chksum_new ("md5"); + _chksum_accumulate (c.obj, str); } -define sha1sum_new () +private define chksum_close (c) { - return chksum_new ("sha1"); + variable chksum = _chksum_close (c.obj;; __qualifiers); + c.obj = NULL; + return chksum; } -define md5sum (str) +private define chksum_digest_length (c) { - variable c = _chksum_new ("md5"); - _chksum_accumulate (c, str); - return _chksum_close (c); + return _chksum_digest_length(c.obj); } -define sha1sum (str) +private define chksum_buffer_size (c) { - variable c = _chksum_new ("sha1"); - _chksum_accumulate (c, str); - return _chksum_close (c); + return _chksum_buffer_size(c.obj); } +define chksum_new (name) +{ + variable q; + (name, q) = parse_name (name;; __qualifiers); + return struct + { + obj = _chksum_new (name;; q), + accumulate = &chksum_accumulate, + close = &chksum_close, + digest_length = &chksum_digest_length, + buffer_size = &chksum_buffer_size, + name = name, + }; +} + + define chksum_file (fp, type) { + variable q; + (type, q) = parse_name (type;; __qualifiers); + variable file = NULL; if (typeof (fp) != File_Type) { @@ -64,7 +163,7 @@ throw OpenError, "Error opening $file"$; } - variable c = _chksum_new (type); + variable c = _chksum_new (type;; q); variable buf; while (-1 != fread_bytes (&buf, 4096, fp)) @@ -75,13 +174,226 @@ return _chksum_close (c); } +define md5sum_new () +{ + return chksum_new ("md5"); +} + +define md5sum (str) +{ + variable c = _chksum_new ("md5"); + _chksum_accumulate (c, str); + return _chksum_close (c;; __qualifiers); +} + define md5sum_file (file) { return chksum_file (file, "md5"); } +define sha1sum_new () +{ + return chksum_new ("sha1"); +} + +define sha1sum (str) +{ + variable c = _chksum_new ("sha1"); + _chksum_accumulate (c, str); + return _chksum_close (c;; __qualifiers); +} + define sha1sum_file (file) { return chksum_file (file, "sha1"); } +define crc8_new () +{ + return chksum_new ("crc8";; __qualifiers); +} + +define crc8sum (str) +{ + variable name, q; + (name, q) = parse_name ("crc8";; __qualifiers); + variable c = _chksum_new (name;; q); + _chksum_accumulate (c, str); + return _chksum_close(c); +} + +define crc8sum_file (file) +{ + return chksum_file (file, "crc8";; __qualifiers); +} + +define crc16_new () +{ + return chksum_new ("crc16";; __qualifiers); +} + +define crc16sum (str) +{ + variable name, q; + (name, q) = parse_name ("crc16";; __qualifiers); + variable c = _chksum_new (name;; q); + _chksum_accumulate (c, str); + return _chksum_close(c); +} + +define crc16sum_file (file) +{ + return chksum_file (file, "crc16";; __qualifiers); +} + +define crc32_new () +{ + return chksum_new ("crc32";; __qualifiers); +} + +define crc32sum (str) +{ + variable name, q; + (name, q) = parse_name ("crc32";; __qualifiers); + variable c = _chksum_new (name;; q); + _chksum_accumulate (c, str); + return _chksum_close(c); +} + +define crc32sum_file (file) +{ + return chksum_file (file, "crc32";; __qualifiers); +} + + +%%% +define sha256sum_new () +{ + return chksum_new ("sha256"); +} + +define sha256sum (str) +{ + variable c = _chksum_new ("sha256"); + _chksum_accumulate (c, str); + return _chksum_close (c;; __qualifiers); +} + +define sha256sum_file (file) +{ + return chksum_file (file, "sha256";; __qualifiers); +} +%%% + +%%% +define sha224sum_new () +{ + return chksum_new ("sha224";; __qualifiers); +} + +define sha224sum (str) +{ + variable c = _chksum_new ("sha224"); + _chksum_accumulate (c, str); + return _chksum_close (c;; __qualifiers); +} + +define sha224sum_file (file) +{ + return chksum_file (file, "sha224";; __qualifiers); +} +%%% + +%%% +define sha512sum_new () +{ + return chksum_new ("sha512"); +} + +define sha512sum (str) +{ + variable c = _chksum_new ("sha512"); + _chksum_accumulate (c, str); + return _chksum_close (c;; __qualifiers); +} + +define sha512sum_file (file) +{ + return chksum_file (file, "sha512";; __qualifiers); +} +%%% + +%%% +define sha384sum_new () +{ + return chksum_new ("sha384"); +} + +define sha384sum (str) +{ + variable c = _chksum_new ("sha384"); + _chksum_accumulate (c, str); + return _chksum_close (c;; __qualifiers); +} + +define sha384sum_file (file) +{ + return chksum_file (file, "sha384";; __qualifiers); +} +%%% + +private define hmac_close (h) +{ + variable inner = _chksum_close(h.obj; binary); + h.obj = NULL; + + _chksum_accumulate(h.obj2, inner); + + variable r = _chksum_close(h.obj2;; __qualifiers); + h.obj2 = NULL; + + return r; +} + +define hmac_new (name, key) +{ + variable obj = _chksum_new(name); + variable obj2 = _chksum_new(name); + variable tmp = _chksum_new(name); + _chksum_accumulate(tmp, key); + variable kk = _chksum_close(tmp; binary); + + if ((typeof(kk) != BString_Type) && (typeof(kk) != String_Type)) + { + throw UsageError, "HMAC requires a hash function producing a binary string"; + } + variable dlen = _chksum_buffer_size(obj); + if (dlen <= 0) + { + throw UsageError, "HMAC requires a secure hash function"; + } + + if (bstrlen(key)>dlen) + { + key = kk; + } + + % generate inner padding array + variable kip = bstring_to_array(key+("\0"B)0:dlen-bstrlen(key)-1/dlen); + kip = array_to_bstring(typecast(kip xor '\x36', UChar_Type)); + _chksum_accumulate(obj, kip); + + % generate outer padding array + variable kop = bstring_to_array(key+("\0"B)0:dlen-bstrlen(key)-1/dlen); + kop = array_to_bstring(typecast(kop xor '\x5c', UChar_Type)); + _chksum_accumulate(obj2, kop); + + return struct + { + obj = obj, + obj2 = obj2, + name = name, + close = &hmac_close, + accumulate = &chksum_accumulate, + }; +}
View file
_service:tar_scm:slang-2.3.3.tar.bz2/modules/chksum_crc.c
Added
@@ -0,0 +1,467 @@ +/* +Copyright (C) 2019-2021,2022 John E. Davis + +This file is part of the S-Lang Library. + +The S-Lang Library is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License as +published by the Free Software Foundation; either version 2 of the +License, or (at your option) any later version. + +The S-Lang 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 +General Public License for more details. + +You should have received a copy of the GNU 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 "config.h" +#include <string.h> +#include <limits.h> +#include <slang.h> +#include <stdint.h> + +#define CHKSUM_TYPE_PRIVATE_FIELDS \ + void *vlookup_table; \ + int refin, refout; \ + unsigned int seed; \ + unsigned int poly; \ + unsigned int xorout; + +#include "chksum.h" + +#define SLang_push_uint16 SLang_push_ushort +#define SLang_push_uint32 SLang_push_uint + +static unsigned char Byte_Reflect256; +static unsigned int reflect_bits (unsigned int val, unsigned int nbits) +{ + unsigned int i; + unsigned int r = 0, s; + + s = (1 << (nbits-1)); + for (i = 0; i < nbits; i++) + { + if (val & 0x00000001) + r |= s; + val = val >> 1; + s = s >> 1; + } + return r; +} + +static void make_byte_reflect_table (void) +{ + static int inited = 0; + unsigned int i; + + if (inited) return; + + for (i = 0; i < 256; i++) + Byte_Reflecti = (unsigned char) reflect_bits (i, 8); + + inited = 1; +} + +typedef struct CRC8_Table_Type_ +{ + struct CRC8_Table_Type_ *next; + unsigned int poly; + unsigned char lookup_table256; +} +CRC8_Table_Type; +static CRC8_Table_Type *CRC8_Table_List; + +static unsigned char *get_crc8_table (unsigned char poly) +{ + CRC8_Table_Type *list; + unsigned char *lookup_table; + unsigned int i; + + list = CRC8_Table_List; + + while (list != NULL) + { + if (list->poly == poly) + return list->lookup_table; + list = list->next; + } + list = (CRC8_Table_Type *)SLmalloc(sizeof(CRC8_Table_Type)); + if (list == NULL) return NULL; + + list->poly = poly; + list->next = CRC8_Table_List; + CRC8_Table_List = list; + + lookup_table = list->lookup_table; + for (i = 0; i < 256; i++) + { + unsigned int j; + unsigned char crc; + + crc = i; + for (j = 0; j < 8; j++) + { + if (crc & 0x80) + crc = (crc << 1)^poly; + else + crc = crc << 1; + } + lookup_tablei = crc; + } + return lookup_table; +} + +static int crc8_accumulate (SLChksum_Type *cs, unsigned char *buf, unsigned int buflen) +{ + unsigned char *lookup_table; + unsigned int i; + unsigned char crc; + + lookup_table = (unsigned char *)cs->vlookup_table; + crc = cs->seed; + + if (cs->refin) + { + for (i = 0; i < buflen; i++) + crc = lookup_tablecrc ^ Byte_Reflectbufi; + } + else + { + for (i = 0; i < buflen; i++) + crc = lookup_tablecrc ^ bufi; + } + cs->seed = crc; + return 0; +} + +static int crc8_close (SLChksum_Type *cs, unsigned char *digest, int just_free) +{ + unsigned char crc; + + if (cs == NULL) + return -1; + + (void) digest; + + if (just_free) + { + SLfree ((char *) cs); + return 0; + } + + crc = (unsigned char) cs->seed & 0xFF; + if (cs->refout) + crc = Byte_Reflectcrc; + crc = (crc ^ cs->xorout) & 0xFF; + + SLfree ((char *)cs); + return SLang_push_uchar (crc); +} + +typedef struct CRC16_Table_Type_ +{ + struct CRC16_Table_Type_ *next; + unsigned int poly; + uint16_t lookup_table256; +} +CRC16_Table_Type; +static CRC16_Table_Type *CRC16_Table_List; + +static uint16_t *get_crc16_table (uint16_t poly) +{ + CRC16_Table_Type *list; + uint16_t *lookup_table; + unsigned int i; + + list = CRC16_Table_List; + while (list != NULL) + { + if (list->poly == poly) + return list->lookup_table; + list = list->next; + } + list = (CRC16_Table_Type *)SLmalloc(sizeof(CRC16_Table_Type)); + if (list == NULL) return NULL; + + list->poly = poly; + list->next = CRC16_Table_List; + CRC16_Table_List = list; + + lookup_table = list->lookup_table; + for (i = 0; i < 256; i++) + { + unsigned int j; + uint16_t crc; + + crc = i << 8; + for (j = 0; j < 8; j++) + { + if (crc & 0x8000) + crc = (crc << 1)^poly; + else + crc = crc << 1; + } + lookup_tablei = crc; + } + return lookup_table; +} + +static int crc16_accumulate (SLChksum_Type *cs, unsigned char *buf, unsigned int buflen) +{ + uint16_t *lookup_table; + unsigned int i; + uint16_t crc; + + lookup_table = (uint16_t *)cs->vlookup_table; + crc = (uint16_t)cs->seed; + + if (cs->refin) + { + for (i = 0; i < buflen; i++) + { + unsigned int j = Byte_Reflectbufi ^ (crc>>8); + crc = lookup_tablej ^ (crc<<8); + } + } + else + { + for (i = 0; i < buflen; i++) + { + unsigned int j = bufi ^ (crc>>8); + crc = lookup_tablej ^ (crc<<8); + } + } + cs->seed = crc; + return 0; +} + +static int crc16_close (SLChksum_Type *cs, unsigned char *digest, int just_free) +{ + uint16_t crc; + + (void) digest; + if (cs == NULL) + return -1; + + if (just_free) + { + SLfree ((char *) cs); + return 0; + } + + crc = cs->seed & 0xFFFF; + if (cs->refout) + crc = reflect_bits (crc, 16); + crc = (crc ^ cs->xorout) & 0xFFFF; + + SLfree ((char *)cs); + return SLang_push_uint16 (crc); +} + +typedef struct CRC32_Table_Type_ +{ + struct CRC32_Table_Type_ *next; + unsigned int poly; + uint32_t lookup_table256; +} +CRC32_Table_Type; +static CRC32_Table_Type *CRC32_Table_List; + + +static uint32_t *get_crc32_table (uint32_t poly) +{ + CRC32_Table_Type *list; + uint32_t *lookup_table; + unsigned int i; + + list = CRC32_Table_List; + while (list != NULL) + { + if (list->poly == poly) + return list->lookup_table; + list = list->next; + } + list = (CRC32_Table_Type *)SLmalloc(sizeof(CRC32_Table_Type)); + if (list == NULL) return NULL; + + list->poly = poly; + list->next = CRC32_Table_List; + CRC32_Table_List = list; + + lookup_table = list->lookup_table; + for (i = 0; i < 256; i++) + { + unsigned int j; + uint32_t crc; + + crc = i << 24; + for (j = 0; j < 8; j++) + { + if (crc & 0x80000000U) + crc = (crc << 1)^poly; + else + crc = crc << 1; + } + lookup_tablei = crc; + } + return lookup_table; +} + +static int crc32_accumulate (SLChksum_Type *cs, unsigned char *buf, unsigned int buflen) +{ + uint32_t *lookup_table; + unsigned int i; + uint32_t crc; + + lookup_table = (uint32_t *)cs->vlookup_table; + crc = (uint32_t)cs->seed; + + if (cs->refin) + { + for (i = 0; i < buflen; i++) + { + unsigned int j = Byte_Reflectbufi ^ (crc>>24); + crc = lookup_tablej ^ (crc<<8); + } + } + else + { + for (i = 0; i < buflen; i++) + { + unsigned int j = bufi ^ (crc>>24); + crc = lookup_tablej ^ (crc<<8); + } + } + cs->seed = crc; + return 0; +} + +static int crc32_close (SLChksum_Type *cs, unsigned char *digest, int just_free) +{ + uint32_t crc; + + (void) digest; + if (cs == NULL) + return -1; + + if (just_free) + { + SLfree ((char *) cs); + return 0; + } + + crc = cs->seed & 0xFFFFFFFFU; + if (cs->refout) + crc = reflect_bits (crc, 32); + crc = (crc ^ cs->xorout) & 0xFFFFFFFFU; + + SLfree ((char *)cs); + return SLang_push_uint32 (crc); +} + +static SLChksum_Type * +chksum_crcxx_new (unsigned int defpoly, unsigned int mask) +{ + SLChksum_Type *cs; + unsigned int poly, seed, xorout; + int refin, refout; + + make_byte_reflect_table (); + + if (-1 == SLang_get_int_qualifier ("refin", &refin, 0)) + return NULL; + + if (-1 == SLang_get_int_qualifier ("refout", &refout, 0)) + return NULL; + + if (-1 == SLang_get_int_qualifier ("xorout", (int *)&xorout, 0)) + return NULL; + + if (-1 == SLang_get_int_qualifier ("seed", (int *)&seed, 0)) + return NULL; + + if (-1 == SLang_get_int_qualifier ("poly", (int *)&poly, defpoly)) + return NULL; + + cs = (SLChksum_Type *)SLmalloc (sizeof (SLChksum_Type)); + if (cs == NULL) + return NULL; + memset ((char *)cs, 0, sizeof (SLChksum_Type)); + + cs->refin = refin; + cs->refout = refout; + cs->xorout = xorout & mask; + cs->seed = seed & mask; + cs->poly = poly & mask; + cs->close_will_push = 1; + + return cs; +} + +SLChksum_Type *_pSLchksum_crc8_new (char *name) +{ + SLChksum_Type *cs; + + (void) name; + if (NULL == (cs = chksum_crcxx_new (0x07, 0xFF))) + return NULL; + + cs->accumulate = crc8_accumulate; + cs->close = crc8_close; + cs->digest_len = 1; + cs->buffer_size = 0; + + if (NULL == (cs->vlookup_table = get_crc8_table (cs->poly))) + { + SLfree ((char *)cs); + return NULL; + } + return cs; +} + +SLChksum_Type *_pSLchksum_crc16_new (char *name) +{ + SLChksum_Type *cs; + + (void) name; + if (NULL == (cs = chksum_crcxx_new (0x1021, 0xFFFF))) + return NULL; + + cs->accumulate = crc16_accumulate; + cs->close = crc16_close; + cs->digest_len = 2; + cs->buffer_size = 0; + + if (NULL == (cs->vlookup_table = get_crc16_table (cs->poly))) + { + SLfree ((char *)cs); + return NULL; + } + return cs; +} + +SLChksum_Type *_pSLchksum_crc32_new (char *name) +{ + SLChksum_Type *cs; + + (void) name; + if (NULL == (cs = chksum_crcxx_new (0x814141ABU, 0xFFFFFFFFU))) + return NULL; + + cs->accumulate = crc32_accumulate; + cs->close = crc32_close; + cs->digest_len = 4; + cs->buffer_size = 0; + + if (NULL == (cs->vlookup_table = get_crc32_table (cs->poly))) + { + SLfree ((char *)cs); + return NULL; + } + return cs; +} +
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/chksum_md5.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/chksum_md5.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2014-2017,2018 John E. Davis +Copyright (C) 2014-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -349,14 +349,14 @@ return 0; } -static int md5_close (SLChksum_Type *md5, unsigned char *digest) +static int md5_close (SLChksum_Type *md5, unsigned char *digest, int just_free) { unsigned char num_bits_buf8; if (md5 == NULL) return -1; - if (digest != NULL) + if ((digest != NULL) && (just_free == 0)) { /* Handle num bits before padding */ uint32_to_uchar (md5->num_bits, 2, num_bits_buf);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/chksum_sha1.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/chksum_sha1.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2014-2017,2018 John E. Davis +Copyright (C) 2014-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -273,14 +273,14 @@ } } -static int sha1_close (SLChksum_Type *sha1, unsigned char *digest) +static int sha1_close (SLChksum_Type *sha1, unsigned char *digest, int just_free) { unsigned char num_bits_buf8; if (sha1 == NULL) return -1; - if (digest != NULL) + if ((digest != NULL) && (just_free == 0)) { /* Handle num bits before padding */ uint32_to_uchar (sha1->num_bits, 2, num_bits_buf); @@ -308,6 +308,7 @@ sha1->accumulate = sha1_accumulate; sha1->close = sha1_close; sha1->digest_len = SHA1_DIGEST_LEN; + sha1->buffer_size = SHA1_BUFSIZE; sha1->h0 = 0x67452301; sha1->h1 = 0xEFCDAB89;
View file
_service:tar_scm:slang-2.3.3.tar.bz2/modules/chksum_sha2.c
Added
@@ -0,0 +1,1031 @@ +/* -*- mode: c; mode: fold; -*- */ + +/* Implementation of the sha2 family: sha256, sha224, sha512, and sha384. + * The implementation loosely follows https://datatracker.ietf.org/doc/html/rfc4634#section-5.2 + * but mapped into the structure as layed out by chksum_sha1.c + */ + +#include "config.h" +#include <string.h> +#include <limits.h> +#include <slang.h> + +#include "_slint.h" + +#define SHA224_BUFSIZE 64 +#define SHA224_DIGEST_LEN 28 +#define SHA256_BUFSIZE 64 +#define SHA256_DIGEST_LEN 32 +#define SHA224_BITSIZE 224 +#define SHA256_BITSIZE 256 +#define SHA384_BUFSIZE 128 +#define SHA384_DIGEST_LEN 48 +#define SHA512_BUFSIZE 128 +#define SHA512_DIGEST_LEN 64 +#define SHA384_BITSIZE 384 +#define SHA512_BITSIZE 512 + +#define CHKSUM_TYPE_PRIVATE_FIELDS \ + unsigned int bitsize; \ + _pSLuint32_Type *h; \ + _pSLuint32_Type num_bits4; /* 64 bit/128 bit representation */ \ + unsigned int num_buffered; \ + unsigned char *buf; + +#include "chksum.h" + +#define SHL(n, x) ((x)<<(n)) +#define SHR(n, x) ((x)>>(n)) +#define ROTR(n, x) (((x)>>(n)) | ((x)<<(32-(n)))) +#define ROTL(n, x) (((x)<<(n)) | ((x)>>(32-(n)))) + +#define CH(x, y, z) (((x) & (y)) ^ ((~(x)) & (z))) +#define MAJ(x, y, z) (((x) & (y)) ^ ((x) & (z)) ^ ((y) & (z))) +#define BSIG0(x) (ROTR( 2, (x)) ^ ROTR(13, (x)) ^ ROTR(22, (x))) +#define BSIG1(x) (ROTR( 6, (x)) ^ ROTR(11, (x)) ^ ROTR(25, (x))) +#define SSIG0(x) (ROTR( 7, (x)) ^ ROTR(18, (x)) ^ SHR( 3, (x))) +#define SSIG1(x) (ROTR(17, (x)) ^ ROTR(19, (x)) ^ SHR(10, (x))) + +#define MAKE_WORD(b) \ + ((((_pSLuint32_Type)((b)0))<<24) | (((_pSLuint32_Type)((b)1))<<16) \ + | (((_pSLuint32_Type)((b)2))<<8) | ((_pSLuint32_Type)((b)3))) + +/* We need some macros to handle 64 bit values to not have to rely on this datatype */ +#if _pSLANG_UINT64_TYPE + +# define ROTR_64(n, x) (((x) >> (n)) | ((x)<<(64-(n)))) +# define ROTL_64(n, x) (((x) << (n)) | ((x)>>(64-(n)))) + +# define BSIG0_64(x) (ROTR_64(28, (x)) ^ ROTR_64(34, (x)) ^ ROTR_64(39, (x))) +# define BSIG1_64(x) (ROTR_64(14, (x)) ^ ROTR_64(18, (x)) ^ ROTR_64(41, (x))) +# define SSIG0_64(x) (ROTR_64( 1, (x)) ^ ROTR_64( 8, (x)) ^ SHR( 7, (x))) +# define SSIG1_64(x) (ROTR_64(19, (x)) ^ ROTR_64(61, (x)) ^ SHR( 6, (x))) + +# define MAKE_LONG_WORD(b) \ + ( \ + (((_pSLuint64_Type)((b)0))<<56) | \ + (((_pSLuint64_Type)((b)1))<<48) | \ + (((_pSLuint64_Type)((b)2))<<40) | \ + (((_pSLuint64_Type)((b)3))<<32) | \ + (((_pSLuint64_Type)((b)4))<<24) | \ + (((_pSLuint64_Type)((b)5))<<16) | \ + (((_pSLuint64_Type)((b)6))<<8) | \ + (((_pSLuint64_Type)((b)7))) \ + ) + +#else /* ! _pSLANG_UINT64_TYPE */ + +/* 64 bit bitshift right */ +# define SHR_64(n, x, r) \ + ( \ + (r)1 = (((n) > 32) \ + ? ((x)0 >> ((n) - 32)) \ + : (((n) == 32) \ + ? (x)0 \ + : (((n) >= 0) \ + ? (((x)0 << (32 - (n))) | ((x)1 >> (n))) \ + : 0) \ + ) \ + ), \ + (r)0 = (((n) < 32) && ((n) >= 0)) ? ((x)0 >> (n)) : 0 \ + ) + +/* 64 bit bitshift left */ +# define SHL_64(n, x, r) \ + ( \ + (r)0 = (((n) > 32) \ + ? ((x)1 << ((n) - 32)) \ + : (((n) == 32) \ + ? (x)1 \ + : (((n) >= 0) \ + ? (((x)0 << (n)) | ((x)1 >> (32 - (n)))) \ + : 0) \ + ) \ + ), \ + (r)1 = (((n) < 32) && ((n) >= 0)) ? ((x)1 << (n)) : 0 \ + ) + +// 64 bit bitwise or +# define OR_64(a, b, r) \ + ( \ + (r)0 = (a)0 | (b)0, \ + (r)1 = (a)1 | (b)1 \ + ) + +// 64 bit bitwise xor +# define XOR_64(a, b, r) \ + ( \ + (r)0 = (a)0 ^ (b)0, \ + (r)1 = (a)1 ^ (b)1 \ + ) + +// 64 bit bitwise and +# define AND_64(a, b, r) \ + ( \ + (r)0 = (a)0 & (b)0, \ + (r)1 = (a)1 & (b)1 \ + ) + +// 64 bit bitwise not +# define NOT_64(x, r) \ + ( \ + (r)0 = ~(x)0, \ + (r)1 = ~(x)1 \ + ) + +// 64 bit add +# define ADD_64(a, b, r) \ + ( \ + (r)1 = (a)1 + (b)1, \ + (r)0 = (a)0 + (b)0 + ((r)1 < (a)1) \ + ) + +// 64 bit rotate right +# define ROTR_64(n, x, tmp, r) \ + ( \ + SHR_64((n), (x), (tmp)), \ + SHL_64(64-(n), (x), (r)), \ + OR_64((tmp), (r), (r))\ + ) + +// 64 bit BSIG0 +# define BSIG0_64(x, t1, t2, t3, r) \ + ( \ + ROTR_64(28, (x), (t3), (t1)), \ + ROTR_64(34, (x), (t3), (t2)), \ + ROTR_64(39, (x), (t3), (r)), \ + XOR_64((t1), (t2), (t2)), \ + XOR_64((t2), (r), (r)) \ + ) + +// 64 bit BSIG1 +# define BSIG1_64(x, t1, t2, t3, r) \ + ( \ + ROTR_64(14, (x), (t3), (t1)), \ + ROTR_64(18, (x), (t3), (t2)), \ + ROTR_64(41, (x), (t3), (r)), \ + XOR_64((t1), (t2), (t2)), \ + XOR_64((t2), (r), (r)) \ + ) + +// 64 bit SSIG0 +# define SSIG0_64(x, t1, t2, t3, r) \ + ( \ + ROTR_64(1, (x), (t3), (t1)), \ + ROTR_64(8, (x), (t3), (t2)), \ + SHR_64( 7, (x), (r)), \ + XOR_64((t1), (t2), (t2)), \ + XOR_64((t2), (r), (r)) \ + ) + +// 64 bit SSIG1 +# define SSIG1_64(x, t1, t2, t3, r) \ + ( \ + ROTR_64(19, (x), (t3), (t1)), \ + ROTR_64(61, (x), (t3), (t2)), \ + SHR_64( 6, (x), (r)), \ + XOR_64((t1), (t2), (t2)), \ + XOR_64((t2), (r), (r)) \ + ) + +// 64 bit CH +# define CH_64(x, y, z, r) \ + ( \ + (r)0 = (((x)0 & ((y)0 ^ (z)0)) ^ (z)0), \ + (r)1 = (((x)1 & ((y)1 ^ (z)1)) ^ (z)1) \ + ) + +// 64 bit MAJ +# define MAJ_64(x, y, z, r) \ + ( \ + (r)0 = (((x)0 & ((y)0 | (z)0)) | ((y)0 & (z)0)), \ + (r)1 = (((x)1 & ((y)1 | (z)1)) | ((y)1 & (z)1)) \ + ) + +#endif /* _pSLANG_UINT64_TYPE */ + +static unsigned int compute_64b_pad_length (unsigned int len) /*{{{*/ +{ + unsigned int mod64 = len % 64; + unsigned int dlen; + + if (mod64 < 56) + dlen = 56 - mod64; + else + dlen = 120 - mod64; + + return dlen; +} +/*}}}*/ + +static unsigned int compute_128b_pad_length (unsigned int len) /*{{{*/ +{ + unsigned int mod1024 = len % 128; + unsigned int dlen; + + if (mod1024 < 112) + dlen = 112 - mod1024; + else + dlen = 240 - mod1024; + + return dlen; +} +/*}}}*/ + +static unsigned char Pad_Bytes128 = /*{{{*/ +{ + 0x80, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 +}; +/*}}}*/ + +static const _pSLuint32_Type SHA256_K = /*{{{*/ +{ + 0x428a2f98, 0x71374491, 0xb5c0fbcf, 0xe9b5dba5, + 0x3956c25b, 0x59f111f1, 0x923f82a4, 0xab1c5ed5, + 0xd807aa98, 0x12835b01, 0x243185be, 0x550c7dc3, + 0x72be5d74, 0x80deb1fe, 0x9bdc06a7, 0xc19bf174, + 0xe49b69c1, 0xefbe4786, 0x0fc19dc6, 0x240ca1cc, + 0x2de92c6f, 0x4a7484aa, 0x5cb0a9dc, 0x76f988da, + 0x983e5152, 0xa831c66d, 0xb00327c8, 0xbf597fc7, + 0xc6e00bf3, 0xd5a79147, 0x06ca6351, 0x14292967, + 0x27b70a85, 0x2e1b2138, 0x4d2c6dfc, 0x53380d13, + 0x650a7354, 0x766a0abb, 0x81c2c92e, 0x92722c85, + 0xa2bfe8a1, 0xa81a664b, 0xc24b8b70, 0xc76c51a3, + 0xd192e819, 0xd6990624, 0xf40e3585, 0x106aa070, + 0x19a4c116, 0x1e376c08, 0x2748774c, 0x34b0bcb5, + 0x391c0cb3, 0x4ed8aa4a, 0x5b9cca4f, 0x682e6ff3, + 0x748f82ee, 0x78a5636f, 0x84c87814, 0x8cc70208, + 0x90befffa, 0xa4506ceb, 0xbef9a3f7, 0xc67178f2 +}; +/*}}}*/ + +#if _pSLANG_UINT64_TYPE +static const _pSLuint64_Type SHA512_K = /*{{{*/ +{ + 0x428a2f98d728ae22, 0x7137449123ef65cd, 0xb5c0fbcfec4d3b2f, 0xe9b5dba58189dbbc, + 0x3956c25bf348b538, 0x59f111f1b605d019, 0x923f82a4af194f9b, 0xab1c5ed5da6d8118, + 0xd807aa98a3030242, 0x12835b0145706fbe, 0x243185be4ee4b28c, 0x550c7dc3d5ffb4e2, + 0x72be5d74f27b896f, 0x80deb1fe3b1696b1, 0x9bdc06a725c71235, 0xc19bf174cf692694, + 0xe49b69c19ef14ad2, 0xefbe4786384f25e3, 0x0fc19dc68b8cd5b5, 0x240ca1cc77ac9c65, + 0x2de92c6f592b0275, 0x4a7484aa6ea6e483, 0x5cb0a9dcbd41fbd4, 0x76f988da831153b5, + 0x983e5152ee66dfab, 0xa831c66d2db43210, 0xb00327c898fb213f, 0xbf597fc7beef0ee4, + 0xc6e00bf33da88fc2, 0xd5a79147930aa725, 0x06ca6351e003826f, 0x142929670a0e6e70, + 0x27b70a8546d22ffc, 0x2e1b21385c26c926, 0x4d2c6dfc5ac42aed, 0x53380d139d95b3df, + 0x650a73548baf63de, 0x766a0abb3c77b2a8, 0x81c2c92e47edaee6, 0x92722c851482353b, + 0xa2bfe8a14cf10364, 0xa81a664bbc423001, 0xc24b8b70d0f89791, 0xc76c51a30654be30, + 0xd192e819d6ef5218, 0xd69906245565a910, 0xf40e35855771202a, 0x106aa07032bbd1b8, + 0x19a4c116b8d2d0c8, 0x1e376c085141ab53, 0x2748774cdf8eeb99, 0x34b0bcb5e19b48a8, + 0x391c0cb3c5c95a63, 0x4ed8aa4ae3418acb, 0x5b9cca4f7763e373, 0x682e6ff3d6b2b8a3, + 0x748f82ee5defb2fc, 0x78a5636f43172f60, 0x84c87814a1f0ab72, 0x8cc702081a6439ec, + 0x90befffa23631e28, 0xa4506cebde82bde9, 0xbef9a3f7b2c67915, 0xc67178f2e372532b, + 0xca273eceea26619c, 0xd186b8c721c0c207, 0xeada7dd6cde0eb1e, 0xf57d4f7fee6ed178, + 0x06f067aa72176fba, 0x0a637dc5a2c898a6, 0x113f9804bef90dae, 0x1b710b35131c471b, + 0x28db77f523047d84, 0x32caab7b40c72493, 0x3c9ebe0a15c9bebc, 0x431d67c49c100d4c, + 0x4cc5d4becb3e42b6, 0x597f299cfc657e2a, 0x5fcb6fab3ad6faec, 0x6c44198c4a475817 +}; +/*}}}*/ +#else /* !_pSLANG_UINT64_TYPE */ +static const _pSLuint32_Type SHA512_K2 = /*{{{*/ +{ + { 0x428a2f98, 0xd728ae22 }, { 0x71374491, 0x23ef65cd }, { 0xb5c0fbcf, 0xec4d3b2f }, { 0xe9b5dba5, 0x8189dbbc }, + { 0x3956c25b, 0xf348b538 }, { 0x59f111f1, 0xb605d019 }, { 0x923f82a4, 0xaf194f9b }, { 0xab1c5ed5, 0xda6d8118 }, + { 0xd807aa98, 0xa3030242 }, { 0x12835b01, 0x45706fbe }, { 0x243185be, 0x4ee4b28c }, { 0x550c7dc3, 0xd5ffb4e2 }, + { 0x72be5d74, 0xf27b896f }, { 0x80deb1fe, 0x3b1696b1 }, { 0x9bdc06a7, 0x25c71235 }, { 0xc19bf174, 0xcf692694 }, + { 0xe49b69c1, 0x9ef14ad2 }, { 0xefbe4786, 0x384f25e3 }, { 0x0fc19dc6, 0x8b8cd5b5 }, { 0x240ca1cc, 0x77ac9c65 }, + { 0x2de92c6f, 0x592b0275 }, { 0x4a7484aa, 0x6ea6e483 }, { 0x5cb0a9dc, 0xbd41fbd4 }, { 0x76f988da, 0x831153b5 }, + { 0x983e5152, 0xee66dfab }, { 0xa831c66d, 0x2db43210 }, { 0xb00327c8, 0x98fb213f }, { 0xbf597fc7, 0xbeef0ee4 }, + { 0xc6e00bf3, 0x3da88fc2 }, { 0xd5a79147, 0x930aa725 }, { 0x06ca6351, 0xe003826f }, { 0x14292967, 0x0a0e6e70 }, + { 0x27b70a85, 0x46d22ffc }, { 0x2e1b2138, 0x5c26c926 }, { 0x4d2c6dfc, 0x5ac42aed }, { 0x53380d13, 0x9d95b3df }, + { 0x650a7354, 0x8baf63de }, { 0x766a0abb, 0x3c77b2a8 }, { 0x81c2c92e, 0x47edaee6 }, { 0x92722c85, 0x1482353b }, + { 0xa2bfe8a1, 0x4cf10364 }, { 0xa81a664b, 0xbc423001 }, { 0xc24b8b70, 0xd0f89791 }, { 0xc76c51a3, 0x0654be30 }, + { 0xd192e819, 0xd6ef5218 }, { 0xd6990624, 0x5565a910 }, { 0xf40e3585, 0x5771202a }, { 0x106aa070, 0x32bbd1b8 }, + { 0x19a4c116, 0xb8d2d0c8 }, { 0x1e376c08, 0x5141ab53 }, { 0x2748774c, 0xdf8eeb99 }, { 0x34b0bcb5, 0xe19b48a8 }, + { 0x391c0cb3, 0xc5c95a63 }, { 0x4ed8aa4a, 0xe3418acb }, { 0x5b9cca4f, 0x7763e373 }, { 0x682e6ff3, 0xd6b2b8a3 }, + { 0x748f82ee, 0x5defb2fc }, { 0x78a5636f, 0x43172f60 }, { 0x84c87814, 0xa1f0ab72 }, { 0x8cc70208, 0x1a6439ec }, + { 0x90befffa, 0x23631e28 }, { 0xa4506ceb, 0xde82bde9 }, { 0xbef9a3f7, 0xb2c67915 }, { 0xc67178f2, 0xe372532b }, + { 0xca273ece, 0xea26619c }, { 0xd186b8c7, 0x21c0c207 }, { 0xeada7dd6, 0xcde0eb1e }, { 0xf57d4f7f, 0xee6ed178 }, + { 0x06f067aa, 0x72176fba }, { 0x0a637dc5, 0xa2c898a6 }, { 0x113f9804, 0xbef90dae }, { 0x1b710b35, 0x131c471b }, + { 0x28db77f5, 0x23047d84 }, { 0x32caab7b, 0x40c72493 }, { 0x3c9ebe0a, 0x15c9bebc }, { 0x431d67c4, 0x9c100d4c }, + { 0x4cc5d4be, 0xcb3e42b6 }, { 0x597f299c, 0xfc657e2a }, { 0x5fcb6fab, 0x3ad6faec }, { 0x6c44198c, 0x4a475817 } +}; +/*}}}*/ +#endif /* _pSLANG_UINT64_TYPE */ + +static int init_sha224_object (SLChksum_Type *chksum) /*{{{*/ +{ + if (NULL == (chksum->h = (_pSLuint32_Type *)SLmalloc(SHA256_BITSIZE/32*sizeof(*(chksum->h))))) + return -1; + + if (NULL == (chksum->buf = (unsigned char *)SLmalloc(SHA224_BUFSIZE*sizeof(*(chksum->buf))))) + return -1; + + chksum->h0 = 0xc1059ed8; + chksum->h1 = 0x367cd507; + chksum->h2 = 0x3070dd17; + chksum->h3 = 0xf70e5939; + chksum->h4 = 0xffc00b31; + chksum->h5 = 0x68581511; + chksum->h6 = 0x64f98fa7; + chksum->h7 = 0xbefa4fa4; + + chksum->buffer_size = SHA224_BUFSIZE; + chksum->bitsize = SHA224_BITSIZE; + chksum->digest_len = SHA224_DIGEST_LEN; + + return 0; +} +/*}}}*/ + +static int init_sha256_object (SLChksum_Type *chksum) /*{{{*/ +{ + if (NULL == (chksum->h = (_pSLuint32_Type *)SLmalloc(SHA256_BITSIZE/32*sizeof(*(chksum->h))))) + return -1; + + if (NULL == (chksum->buf = (unsigned char *)SLmalloc(SHA256_BUFSIZE*sizeof(*(chksum->buf))))) + return -1; + + chksum->h0 = 0x6a09e667; + chksum->h1 = 0xbb67ae85; + chksum->h2 = 0x3c6ef372; + chksum->h3 = 0xa54ff53a; + chksum->h4 = 0x510e527f; + chksum->h5 = 0x9b05688c; + chksum->h6 = 0x1f83d9ab; + chksum->h7 = 0x5be0cd19; + + chksum->buffer_size = SHA256_BUFSIZE; + chksum->bitsize = SHA256_BITSIZE; + chksum->digest_len = SHA256_DIGEST_LEN; + + return 0; +} +/*}}}*/ + +static int init_sha384_object (SLChksum_Type *chksum) /*{{{*/ +{ + if (NULL == (chksum->h = (_pSLuint32_Type *)SLmalloc(SHA512_BITSIZE/32*sizeof(*(chksum->h))))) + return -1; + + if (NULL == (chksum->buf = (unsigned char *)SLmalloc(SHA384_BUFSIZE*sizeof(*(chksum->buf))))) + return -1; + +#if _pSLANG_UINT64_TYPE + ((_pSLuint64_Type*)(chksum->h))0 = 0xcbbb9d5dc1059ed8; + ((_pSLuint64_Type*)(chksum->h))1 = 0x629a292a367cd507; + ((_pSLuint64_Type*)(chksum->h))2 = 0x9159015a3070dd17; + ((_pSLuint64_Type*)(chksum->h))3 = 0x152fecd8f70e5939; + ((_pSLuint64_Type*)(chksum->h))4 = 0x67332667ffc00b31; + ((_pSLuint64_Type*)(chksum->h))5 = 0x8eb44a8768581511; + ((_pSLuint64_Type*)(chksum->h))6 = 0xdb0c2e0d64f98fa7; + ((_pSLuint64_Type*)(chksum->h))7 = 0x47b5481dbefa4fa4; +#else /* !_pSLANG_UINT64_TYPE */ + ((_pSLuint32_Type (*)2)(chksum->h))00 = 0xcbbb9d5d; ((_pSLuint32_Type (*)2)(chksum->h))01 = 0xc1059ed8; + ((_pSLuint32_Type (*)2)(chksum->h))10 = 0x629a292a; ((_pSLuint32_Type (*)2)(chksum->h))11 = 0x367cd507; + ((_pSLuint32_Type (*)2)(chksum->h))20 = 0x9159015a; ((_pSLuint32_Type (*)2)(chksum->h))21 = 0x3070dd17; + ((_pSLuint32_Type (*)2)(chksum->h))30 = 0x152fecd8; ((_pSLuint32_Type (*)2)(chksum->h))31 = 0xf70e5939; + ((_pSLuint32_Type (*)2)(chksum->h))40 = 0x67332667; ((_pSLuint32_Type (*)2)(chksum->h))41 = 0xffc00b31; + ((_pSLuint32_Type (*)2)(chksum->h))50 = 0x8eb44a87; ((_pSLuint32_Type (*)2)(chksum->h))51 = 0x68581511; + ((_pSLuint32_Type (*)2)(chksum->h))60 = 0xdb0c2e0d; ((_pSLuint32_Type (*)2)(chksum->h))61 = 0x64f98fa7; + ((_pSLuint32_Type (*)2)(chksum->h))70 = 0x47b5481d; ((_pSLuint32_Type (*)2)(chksum->h))71 = 0xbefa4fa4; +#endif /* !_pSLANG_UINT64_TYPE */ + + chksum->buffer_size = SHA384_BUFSIZE; + chksum->bitsize = SHA384_BITSIZE; + chksum->digest_len = SHA384_DIGEST_LEN; + + return 0; +} +/*}}}*/ + +static int init_sha512_object (SLChksum_Type *chksum) /*{{{*/ +{ + if (NULL == (chksum->h = (_pSLuint32_Type *)SLmalloc(SHA512_BITSIZE/32*sizeof(*(chksum->h))))) + return -1; + + if (NULL == (chksum->buf = (unsigned char *)SLmalloc(SHA512_BUFSIZE*sizeof(*(chksum->buf))))) + return -1; + +#if _pSLANG_UINT64_TYPE + ((_pSLuint64_Type*)(chksum->h))0 = 0x6a09e667f3bcc908; + ((_pSLuint64_Type*)(chksum->h))1 = 0xbb67ae8584caa73b; + ((_pSLuint64_Type*)(chksum->h))2 = 0x3c6ef372fe94f82b; + ((_pSLuint64_Type*)(chksum->h))3 = 0xa54ff53a5f1d36f1; + ((_pSLuint64_Type*)(chksum->h))4 = 0x510e527fade682d1; + ((_pSLuint64_Type*)(chksum->h))5 = 0x9b05688c2b3e6c1f; + ((_pSLuint64_Type*)(chksum->h))6 = 0x1f83d9abfb41bd6b; + ((_pSLuint64_Type*)(chksum->h))7 = 0x5be0cd19137e2179; +#else /* !_pSLANG_UINT64_TYPE */ + ((_pSLuint32_Type (*)2)(chksum->h))00 = 0x6a09e667; ((_pSLuint32_Type (*)2)(chksum->h))01 = 0xf3bcc908; + ((_pSLuint32_Type (*)2)(chksum->h))10 = 0xbb67ae85; ((_pSLuint32_Type (*)2)(chksum->h))11 = 0x84caa73b; + ((_pSLuint32_Type (*)2)(chksum->h))20 = 0x3c6ef372; ((_pSLuint32_Type (*)2)(chksum->h))21 = 0xfe94f82b; + ((_pSLuint32_Type (*)2)(chksum->h))30 = 0xa54ff53a; ((_pSLuint32_Type (*)2)(chksum->h))31 = 0x5f1d36f1; + ((_pSLuint32_Type (*)2)(chksum->h))40 = 0x510e527f; ((_pSLuint32_Type (*)2)(chksum->h))41 = 0xade682d1; + ((_pSLuint32_Type (*)2)(chksum->h))50 = 0x9b05688c; ((_pSLuint32_Type (*)2)(chksum->h))51 = 0x2b3e6c1f; + ((_pSLuint32_Type (*)2)(chksum->h))60 = 0x1f83d9ab; ((_pSLuint32_Type (*)2)(chksum->h))61 = 0xfb41bd6b; + ((_pSLuint32_Type (*)2)(chksum->h))70 = 0x5be0cd19; ((_pSLuint32_Type (*)2)(chksum->h))71 = 0x137e2179; +#endif /* !_pSLANG_UINT64_TYPE */ + + chksum->buffer_size = SHA512_BUFSIZE; + chksum->bitsize = SHA512_BITSIZE; + chksum->digest_len = SHA512_DIGEST_LEN; + + return 0; +} +/*}}}*/ + +static _pSLuint32_Type overflow_add (_pSLuint32_Type a, _pSLuint32_Type b, _pSLuint32_Type *c) /*{{{*/ +{ + _pSLuint32_Type b1 = (_pSLuint32_Type)(-1) - b; + if (a <= b1) + { + *c = 0; + return a+b; + } + *c = 1; + return (a - b1) - 1; +} +/*}}}*/ + +#if _pSLANG_UINT64_TYPE +static _pSLuint64_Type overflow_add_long (_pSLuint64_Type a, _pSLuint64_Type b, _pSLuint64_Type *c) /*{{{*/ +{ + _pSLuint64_Type b1 = (_pSLuint64_Type)(-1) - b; + + if (a <= b1) + { + *c = 0; + return a+b; + } + *c = 1; + return (a - b1) - 1; +} +/*}}}*/ +#endif + +static int update_num_bits_long (SLChksum_Type *chksum, unsigned int dnum_bits) /*{{{*/ +{ +#if _pSLANG_UINT64_TYPE + _pSLuint64_Type lo, hi, c; + hi = ((_pSLuint64_Type*)(chksum->num_bits))0; + lo = ((_pSLuint64_Type*)(chksum->num_bits))1; + + lo = overflow_add_long(lo, (_pSLuint64_Type)dnum_bits << 3, &c); + if (c) + { + hi = overflow_add_long(hi, c, &c); + if (c) + return -1; + } + hi = overflow_add_long(hi, dnum_bits >> 29, &c); + if (c) + return -1; + + ((_pSLuint64_Type*)(chksum->num_bits))0 = hi; + ((_pSLuint64_Type*)(chksum->num_bits))1 = lo; +#else /* !_pSLANG_UINT64_TYPE */ + _pSLuint32_Type l1, l2, l3, l4, c; + + l1 = chksum->num_bits0; + l2 = chksum->num_bits1; + l3 = chksum->num_bits2; + l4 = chksum->num_bits3; + + l4 = overflow_add(l4, (_pSLuint32_Type)dnum_bits << 3, &c); + if (c) + { + l3 = overflow_add(l3, c, &c); + if (c) + { + l2 = overflow_add(l2, c, &c); + if (c) + { + l1 = overflow_add(l1, c, &c); + if (c) + return -1; + } + } + } + l3 = overflow_add(l3, dnum_bits >> 29, &c); + if (c) + { + l2 = overflow_add(l2, c, &c); + if (c) + { + l1 = overflow_add(l1, c, &c); + if (c) + return -1; + } + } + + chksum->num_bits0 = l1; + chksum->num_bits1 = l2; + chksum->num_bits2 = l3; + chksum->num_bits3 = l4; +#endif /* !_pSLANG_UINT64_TYPE */ + + return 0; +} +/*}}}*/ + +static int update_num_bits (SLChksum_Type *chksum, unsigned int dnum_bits) /*{{{*/ +{ + _pSLuint32_Type l1, l2, c, d; + + d = (_pSLuint32_Type)dnum_bits << 3; // *8 bytes to bits + l1 = chksum->num_bits0; + l2 = chksum->num_bits1; + + l2 = overflow_add(l2, d, &c); + if (c) + { + l1 = overflow_add(l1, c, &c); + if (c) + return -1; + } + l1 = overflow_add(l1, dnum_bits >> 29, &c); + if (c) + return -1; + + chksum->num_bits0 = l1; + chksum->num_bits1 = l2; + + return 0; +} +/*}}}*/ + +static void sha256_process_block (SLChksum_Type *sha256, unsigned char *buf) /*{{{*/ +{ + _pSLuint32_Type a,b,c,d,e,f,g,h; + _pSLuint32_Type w64; + unsigned int t; + + for (t=0; t<16; t++) + { + wt = MAKE_WORD(buf); + buf += 4; + } + + for (t=16; t<64; t++) + wt = SSIG1(wt-2) + wt-7 + SSIG0(wt-15) + wt-16; + + a = sha256->h0; + b = sha256->h1; + c = sha256->h2; + d = sha256->h3; + e = sha256->h4; + f = sha256->h5; + g = sha256->h6; + h = sha256->h7; + + for (t=0; t<64; t++) + { + _pSLuint32_Type t1 = h + BSIG1(e) + CH(e,f,g) + SHA256_Kt + wt; + _pSLuint32_Type t2 = BSIG0(a) + MAJ(a,b,c); + h = g; + g = f; + f = e; + e = d + t1; + d = c; + c = b; + b = a; + a = t1 + t2; + } + + sha256->h0 += a; + sha256->h1 += b; + sha256->h2 += c; + sha256->h3 += d; + sha256->h4 += e; + sha256->h5 += f; + sha256->h6 += g; + sha256->h7 += h; +} +/*}}}*/ + +static void sha512_process_block (SLChksum_Type *sha512, unsigned char *buf) /*{{{*/ +{ + unsigned int t; +#if _pSLANG_UINT64_TYPE + _pSLuint64_Type a, b, c, d, e, f, g, h, t1, t2; + _pSLuint64_Type w80; + + for (t=0; t<16; t++) + { + wt = MAKE_LONG_WORD(buf); + buf += 8; + } + + for (t=16; t<80; t++) + wt = SSIG1_64(wt-2) + wt-7 + SSIG0_64(wt-15) + wt-16; + + a = ((_pSLuint64_Type*)(sha512->h))0; + b = ((_pSLuint64_Type*)(sha512->h))1; + c = ((_pSLuint64_Type*)(sha512->h))2; + d = ((_pSLuint64_Type*)(sha512->h))3; + e = ((_pSLuint64_Type*)(sha512->h))4; + f = ((_pSLuint64_Type*)(sha512->h))5; + g = ((_pSLuint64_Type*)(sha512->h))6; + h = ((_pSLuint64_Type*)(sha512->h))7; + + for (t=0; t<80; t++) + { + t1 = h + BSIG1_64(e) + CH(e, f, g) + SHA512_Kt + wt; + t2 = BSIG0_64(a) + MAJ(a,b,c); + h = g; + g = f; + f = e; + e = d + t1; + d = c; + c = b; + b = a; + a = t1 + t2; + } + + ((_pSLuint64_Type*)(sha512->h))0 += a; + ((_pSLuint64_Type*)(sha512->h))1 += b; + ((_pSLuint64_Type*)(sha512->h))2 += c; + ((_pSLuint64_Type*)(sha512->h))3 += d; + ((_pSLuint64_Type*)(sha512->h))4 += e; + ((_pSLuint64_Type*)(sha512->h))5 += f; + ((_pSLuint64_Type*)(sha512->h))6 += g; + ((_pSLuint64_Type*)(sha512->h))7 += h; +#else /* !_pSLANG_UINT64_TYPE */ + _pSLuint32_Type a2, b2, c2, d2, e2, f2, g2, h2; + _pSLuint32_Type t12, t22; + _pSLuint32_Type w802; + _pSLuint32_Type _tmp12, _tmp22, _tmp32, r2; + _pSLuint32_Type (*ch)2 = (_pSLuint32_Type (*)2)(sha512->h); + + for (t=0; t<16; t++) + { + wt0 = MAKE_WORD(buf); + wt1 = MAKE_WORD(buf+4); + buf += 8; + } + + for (t=16; t<80; t++) + { + SSIG1_64(wt-2, _tmp1, _tmp2, _tmp3, r); + wt0 = r0; wt1 = r1; + ADD_64(wt-7, wt, wt); + SSIG0_64(wt-15, _tmp1, _tmp2, _tmp3, r); + ADD_64(r, wt, wt); + ADD_64(wt-16, wt, wt); + } + + a0 = ch00; a1 = ch01; + b0 = ch10; b1 = ch11; + c0 = ch20; c1 = ch21; + d0 = ch30; d1 = ch31; + e0 = ch40; e1 = ch41; + f0 = ch50; f1 = ch51; + g0 = ch60; g1 = ch61; + h0 = ch70; h1 = ch71; + + for (t=0; t<80; t++) + { + // t1 = h + BSIG1(e) + CH(e,f,g) + SHA512_Kt + wt + t10 = h0; t11 = h1; + BSIG1_64(e, _tmp1, _tmp2, _tmp3, r); + ADD_64(r, t1, t1); + CH_64(e, f, g, r); + ADD_64(r, t1, t1); + ADD_64(SHA512_Kt, t1, t1); + ADD_64(wt, t1, t1); + + // t2 = BSIG0(a) + MAJ(a,b,c) + BSIG0_64(a, _tmp1, _tmp2, _tmp3, r); + t20 = r0; t21 = r1; + MAJ_64(a, b, c, r); + ADD_64(r, t2, t2); + + h0 = g0; h1 = g1; + g0 = f0; g1 = f1; + f0 = e0; f1 = e1; + e0 = d0; e1 = d1; + ADD_64(t1, e, e); + d0 = c0; d1 = c1; + c0 = b0; c1 = b1; + b0 = a0; b1 = a1; + a0 = t10; a1 = t11; + ADD_64(t2, a, a); + } + + ADD_64(a, ch0, ch0); + ADD_64(b, ch1, ch1); + ADD_64(c, ch2, ch2); + ADD_64(d, ch3, ch3); + ADD_64(e, ch4, ch4); + ADD_64(f, ch5, ch5); + ADD_64(g, ch6, ch6); + ADD_64(h, ch7, ch7); +#endif /* !_pSLANG_UINT64_TYPE */ +} +/*}}}*/ + +static int sha256_accumulate (SLChksum_Type *sha256, unsigned char *buf, unsigned int buflen) /*{{{*/ +{ + unsigned int num_buffered; + unsigned char *bufmax; + + if ((sha256 == NULL) || (buf == NULL)) + return -1; + + update_num_bits (sha256, buflen); + + num_buffered = sha256->num_buffered; + + if (num_buffered) + { + unsigned int dlen = sha256->buffer_size - sha256->num_buffered; + + if (buflen < dlen) + dlen = buflen; + + memcpy (sha256->buf+num_buffered, buf, dlen); + num_buffered += dlen; + buflen -= dlen; + buf += dlen; + + if (num_buffered < sha256->buffer_size) + { + sha256->num_buffered = num_buffered; + return 0; + } + + sha256_process_block (sha256, sha256->buf); + num_buffered = 0; + } + + num_buffered = buflen % sha256->buffer_size; + bufmax = buf + (buflen - num_buffered); + while (buf < bufmax) + { + sha256_process_block (sha256, buf); + buf += sha256->buffer_size; + } + + if (num_buffered) + memcpy (sha256->buf, bufmax, num_buffered); + + sha256->num_buffered = num_buffered; + + return 0; +} +/*}}}*/ + +static int sha512_accumulate (SLChksum_Type *sha512, unsigned char *buf, unsigned int buflen) /*{{{*/ +{ + unsigned int num_buffered; + unsigned char *bufmax; + + if ((sha512 == NULL) || (buf == NULL)) + return -1; + + update_num_bits_long (sha512, buflen); + + num_buffered = sha512->num_buffered; + + if (num_buffered) + { + unsigned int dlen = sha512->buffer_size - sha512->num_buffered; + + if (buflen < dlen) + dlen = buflen; + + memcpy (sha512->buf+num_buffered, buf, dlen); + num_buffered += dlen; + buflen -= dlen; + buf += dlen; + + if (num_buffered < sha512->buffer_size) + { + sha512->num_buffered = num_buffered; + return 0; + } + + sha512_process_block (sha512, sha512->buf); + num_buffered = 0; + } + + num_buffered = buflen % sha512->buffer_size; + bufmax = buf + (buflen - num_buffered); + while (buf < bufmax) + { + sha512_process_block (sha512, buf); + buf += sha512->buffer_size; + } + + if (num_buffered) + memcpy (sha512->buf, bufmax, num_buffered); + + sha512->num_buffered = num_buffered; + + return 0; +} +/*}}}*/ + +static void uint32_to_uchar (_pSLuint32_Type *u, unsigned int num, unsigned char *buf) /*{{{*/ +{ + unsigned int i; + + for (i = 0; i < num; i++) + { + _pSLuint32_Type x = ui; + buf3 = (unsigned char) (x & 0xFF); + buf2 = (unsigned char) ((x>>8) & 0xFF); + buf1 = (unsigned char) ((x>>16) & 0xFF); + buf0 = (unsigned char) ((x>>24) & 0xFF); + buf += 4; + } +} +/*}}}*/ + +static void uint64_to_uchar (_pSLuint32_Type *u, unsigned int num, unsigned char *buf) /*{{{*/ +{ + unsigned int i; +#if _pSLANG_UINT64_TYPE + _pSLuint64_Type *v = (_pSLuint64_Type*)u; + + for (i=0; i<num; i++) + { + _pSLuint64_Type x = vi; + buf7 = (unsigned char)(x & 0xFF); + buf6 = (unsigned char)((x>>8) & 0xFF); + buf5 = (unsigned char)((x>>16) & 0xFF); + buf4 = (unsigned char)((x>>24) & 0xFF); + + buf3 = (unsigned char)((x>>32) & 0xFF); + buf2 = (unsigned char)((x>>40) & 0xFF); + buf1 = (unsigned char)((x>>48) & 0xFF); + buf0 = (unsigned char)((x>>56) & 0xFF); + + buf += 8; + } +#else /* !_pSLANG_UINT64_TYPE */ + _pSLuint32_Type (*v)2 = (_pSLuint32_Type (*)2)u; + + for (i=0; i<num; i++) + { + _pSLuint32_Type x2; + x0 = vi0; + x1 = vi1; + buf7 = (unsigned char)(x1 & 0xFF); + buf6 = (unsigned char)((x1>>8) & 0xFF); + buf5 = (unsigned char)((x1>>16) & 0xFF); + buf4 = (unsigned char)((x1>>24) & 0xFF); + + buf3 = (unsigned char)(x0 & 0xFF); + buf2 = (unsigned char)((x0>>8) & 0xFF); + buf1 = (unsigned char)((x0>>16) & 0xFF); + buf0 = (unsigned char)((x0>>24) & 0xFF); + + buf += 8; + } +#endif /* _pSLANG_UINT64_TYPE */ +} +/*}}}*/ + +static int sha256_close (SLChksum_Type *sha256, unsigned char *digest, int just_free) /*{{{*/ +{ + unsigned char num_bits_buf8; + + if (sha256 == NULL) + return -1; + + if ((digest != NULL) && (just_free == 0)) + { + /* Handle num bits before padding */ + uint32_to_uchar (sha256->num_bits, 2, num_bits_buf); + + /* Add pad and num_bits bytes */ + (void) sha256_accumulate (sha256, Pad_Bytes, compute_64b_pad_length (sha256->num_buffered)); + (void) sha256_accumulate (sha256, num_bits_buf, 8); + uint32_to_uchar(sha256->h, sha256->bitsize/32, digest); + } + + // clear it to not leave sensitive data long lived + memset(sha256->buf, 0, sha256->buffer_size); + + SLfree((char*)(sha256->buf)); + SLfree((char*)(sha256->h)); + SLfree ((char *)sha256); + return 0; +} +/*}}}*/ + +static int sha512_close (SLChksum_Type *sha512, unsigned char *digest, int just_free) /*{{{*/ +{ + unsigned char num_bits_buf16; + + if (sha512 == NULL) + return -1; + + if ((digest != NULL) && (just_free == 0)) + { + /* Handle num bits before padding */ + uint64_to_uchar (sha512->num_bits, 2, num_bits_buf); + + /* Add pad and num_bits bytes */ + (void) sha512_accumulate (sha512, Pad_Bytes, compute_128b_pad_length (sha512->num_buffered)); + (void) sha512_accumulate (sha512, num_bits_buf, 16); + uint64_to_uchar(sha512->h, sha512->bitsize/64, digest); + } + + /* clear it to not leave sensitive data long lived */ + memset(sha512->buf, 0, sha512->buffer_size); + + SLfree((char*)(sha512->buf)); + SLfree((char*)(sha512->h)); + SLfree ((char *)sha512); + return 0; +} +/*}}}*/ + +SLChksum_Type *_pSLchksum_sha256_new (char *name) /*{{{*/ +{ + SLChksum_Type *sha256; + + if (NULL == (sha256 = (SLChksum_Type *)SLmalloc (sizeof (SLChksum_Type)))) + return NULL; + + memset ((char *)sha256, 0, sizeof (SLChksum_Type)); + + sha256->accumulate = sha256_accumulate; + sha256->close = sha256_close; + + if (0 == strcmp(name, "sha256")) + { + if (init_sha256_object(sha256)) + goto error_return; + } + else if (0 == strcmp(name, "sha224")) + { + if (init_sha224_object(sha256)) + goto error_return; + } + else + goto error_return; + + return sha256; + +error_return: + SLfree((char*)(sha256->h)); + SLfree((char*)(sha256->buf)); + SLfree((char*)sha256); + + return NULL; +} +/*}}}*/ + +SLChksum_Type *_pSLchksum_sha512_new (char *name) /*{{{*/ +{ + SLChksum_Type *sha512; + + if (NULL == (sha512 = (SLChksum_Type *)SLmalloc (sizeof (SLChksum_Type)))) + return NULL; + + memset ((char *)sha512, 0, sizeof (SLChksum_Type)); + + sha512->accumulate = sha512_accumulate; + sha512->close = sha512_close; + + if (0 == strcmp(name, "sha512")) + { + if (init_sha512_object(sha512)) + goto error_return; + } + else if (0 == strcmp(name, "sha384")) + { + if (init_sha384_object(sha512)) + goto error_return; + } + else + goto error_return; + + return sha512; + +error_return: + SLfree((char*)(sha512->h)); + SLfree((char*)(sha512->buf)); + SLfree((char*)sha512); + + return NULL; +} +/*}}}*/
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/csv-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/csv-module.c
Changed
@@ -28,13 +28,14 @@ return 0; } -static int execute_read_callback (CSV_Type *csv, char **sptr) +static int execute_read_callback (CSV_Type *csv, int in_quote, char **sptr) { char *s; *sptr = NULL; if ((-1 == SLang_start_arg_list ()) + || (-1 == SLang_push_int (in_quote)) || (-1 == SLang_push_anytype (csv->callback_data)) || (-1 == SLang_end_arg_list ()) || (-1 == SLexecute_function (csv->read_callback))) @@ -139,15 +140,16 @@ || (0 == (ch = lineline_ofs++)) \ || (ch == '\r')) \ { \ - if ((do_read == 0) && (ch == '\r') && (lineline_ofs == '\n')) \ + if ((do_read == 0) && (ch == '\r')) \ { \ + if (lineline_ofs != '\n') break; \ line_ofs++; \ ch = '\n'; \ break; \ } \ SLang_free_slstring (line); \ line = NULL; \ - status = execute_read_callback (csv, &line); \ + status = execute_read_callback (csv, in_quote, &line); \ do_read = 0; \ if (status == -1) \ goto return_error; \
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/csv.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/csv.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for @@ -6,7 +6,7 @@ %--------------------------------------------------------------------------- import ("csv"); -private define read_fp_callback (info) +private define read_fp_callback (in_quote, info) { variable line, comment_char = info.comment_char; forever @@ -14,15 +14,17 @@ if (-1 == fgets (&line, info.fp)) return NULL; + info.line_num++; if ((line0 == comment_char) - && (0 == strnbytecmp (line, info.comment, info.comment_len))) + && (in_quote == 0) + && (0 == strnbytecmp (line, info.comment, info.comment_len))) continue; return line; } } -private define read_strings_callback (str_info) +private define read_strings_callback (in_quote, str_info) { variable line; @@ -39,27 +41,48 @@ if (line-1 != '\n') str_info.output_crlf = 1; + str_info.line_num++; return line; } -private define resize_arrays (list, n) +private define resize_arrays (arrays, n) { - _for (0, length(list)-1, 1) + _for (0, length(arrays)-1, 1) { variable i = (); - variable a = listi; + variable a = arraysi; variable m = length(a); + if (m == n) continue; if (m > n) { - listi = a:n-1; + arraysi = a:n-1; continue; } variable b = _typeof(a)n; b:m-1 = a; - listi = b; + arraysi = b; } } +private define merge_column_arrays (list_of_column_arrays) +{ + variable j, n = length (list_of_column_arrays); + variable column_arrays = list_of_column_arrays0; + variable i, ncols = length (column_arrays); + variable merged = {}; + _for i (0, ncols-1, 1) + { + variable array_list = {}; + _for j (0, n-1, 1) + { + column_arrays = list_of_column_arraysj; + list_append (array_list, column_arraysi); + } + list_append (merged, __push_list(__tmp(array_list))); + } + return merged; +} + private define atofloat (x) { typecast (atof(x), Float_Type); @@ -99,18 +122,7 @@ variable i = where (names == ""); namesi = array_map (String_Type, &sprintf, "col%d", i+1); -#iffalse - % This code is nolonger necessary since slang now allows arbitrary - % structure names. - names = strtrans (names, "^\\w", "_"); - names = strcompress (names, "_"); - - _for i (0, length(names)-1, 1) - { - if ('0' <= namesi0 <= '9') - namesi = "_" + namesi; - } -#endif + names = strtrim (names); % strip leading/trailing WS if (is_scalar) names = names0; return names; } @@ -147,6 +159,7 @@ typeNTH=val (specifiy type for NTH column)\n\ snan=\"\", inan=0, lnan=0L, fnan=_NaN, dnan=_NaN (defaults for empty fields),\n\ nanNTH=val (value used for an empty field in the NTH column\n\ + init_size=int (number of rows to initially read)\n\ " ); } @@ -166,6 +179,8 @@ variable fnan = qualifier ("fnan", typecast(_NaN,Float_Type)); variable inan = qualifier ("inan", 0); variable lnan = qualifier ("lnan", 0L); + variable init_size = qualifier ("init_size", 0x8000); + if (init_size <= 0) init_size = 0x8000; if ((fields != NULL) && (columns != NULL) && (length(fields) != length(columns))) @@ -190,22 +205,49 @@ col = columnsi; j = wherefirst (col == header); if (j == NULL) - throw InvalidParmError, "Unknown (canonical) column name $col"; + throw InvalidParmError, "Unknown (canonical) column name $col"$; column_intsi = j+1; } } - variable row_data = _csv_decode_row (csv.decoder, flags); - if (column_ints == NULL) - column_ints = 1:length(row_data); + variable datastruct = NULL, ncols, row_data, e; + try (e) + { + row_data = _csv_decode_row (csv.decoder, flags); + } + catch AnyError: + { + throw e.error, sprintf ("Error encountered decoding line %S: %S", csv.func_data.line_num, e.message); + } - if (any(column_ints>length(row_data))) + variable nread = 0; + if (row_data != NULL) { - throw InvalidParmError, "column number is too large for data"; + nread++; + + if (column_ints == NULL) + column_ints = 1:length(row_data); + + if (any(column_ints>length(row_data))) + { + throw InvalidParmError, "column number is too large for data"; + } + } + + if (column_ints == NULL) + { + if (fields != NULL) + ncols = length(fields); + else if (columns_are_string) + ncols = length(columns); + else if (header != NULL) + ncols = length (header); + else + throw RunTimeError, "Insufficient information to determine the number of columns in the CSV file"; + + column_ints = 1:ncols; } - variable ncols = length(column_ints); - variable datastruct = NULL; if (fields == NULL) { if (columns_are_string) @@ -215,6 +257,7 @@ else fields = array_map(String_Type, &sprintf, "col%d", column_ints); } + ncols = length(fields); datastruct = @Struct_Type(fields); column_ints -= 1; % make 0-based @@ -243,7 +286,9 @@ _for i (1, ncols, 1) { i1 = i-1; - typesi1 = qualifier ("type$i"$, typesi1); + val = qualifier ("type$i"$, typesi1); + + typesi1 = val; } i = where(types=='i'); @@ -266,27 +311,30 @@ { convert_funcsi1 = &atof; nan_valuesi1 = dnan; - typesi1 = 'd'; } else if (type == Int_Type) { convert_funcsi1 = &atoi; nan_valuesi1 = inan; - typesi1 = 'i'; } - else typesi1 = 's'; } val = nan_valuesi1; nan_valuesi1 = typecast (qualifier ("nan$i"$, val), typeof(val)); } - variable list_of_arrays = {}, array; - variable init_size = 0x8000; + variable column_arrays = Array_Typencols, array; variable dsize = init_size; variable max_allocated = init_size; + variable list_of_column_arrays = {}; _for i (0, ncols-1, 1) { + if (row_data == NULL) + { + column_arraysi = typeof(nan_valuesi)0; + continue; + } + val = row_datacolumn_intsi; array = typeof(nan_valuesi)max_allocated; ifnot (strbytelen(val)) @@ -298,13 +346,23 @@ val = (@convert_func)(val); } array0 = val; - list_append (list_of_arrays, array); + column_arraysi = array; } + list_append (list_of_column_arrays, column_arrays); - variable nread = 1; variable min_row_size = 1+max(column_ints); - while (row_data = _csv_decode_row (csv.decoder, flags), row_data != NULL) + forever { + try (e) + { + row_data = _csv_decode_row (csv.decoder, flags); + } + catch AnyError: + { + throw e.error, sprintf ("Error encountered decoding line %S: %S", csv.func_data.line_num, e.message); + } + if (row_data == NULL) break; + if (length (row_data) < min_row_size) { % FIXME-- make what to do here configurable @@ -316,8 +374,11 @@ if (nread >= max_allocated) { - max_allocated += dsize; - resize_arrays (list_of_arrays, max_allocated); + column_arrays = Array_Typencols; + _for i (0, ncols-1, 1) + column_arraysi = _typeof(list_of_column_arrays0i)max_allocated; + list_append (list_of_column_arrays, column_arrays); + nread = 0; } _for i (0, ncols-1, 1) @@ -325,21 +386,23 @@ val = row_datacolumn_intsi; ifnot (strbytelen(val)) { - list_of_arraysinread = nan_valuesi; + column_arraysinread = nan_valuesi; continue; } convert_func = convert_funcsi; if (convert_func == NULL) { - list_of_arraysinread = val; + column_arraysinread = val; continue; } - list_of_arraysinread = (@convert_func)(val); + column_arraysinread = (@convert_func)(val); } nread++; } - resize_arrays (list_of_arrays, nread); - set_struct_fields (datastruct, __push_list(list_of_arrays)); + resize_arrays (__tmp(column_arrays), nread); + list_of_column_arrays = merge_column_arrays (__tmp(list_of_column_arrays)); + + set_struct_fields (datastruct, __push_list(list_of_column_arrays)); return datastruct; } @@ -352,7 +415,7 @@ quote='\"', delim=',', skiplines=0, comment=string"); variable fp = (); - variable type = typeof(fp); + variable type = typeof(fp), file = fp; variable func = &read_fp_callback; variable func_data; @@ -369,6 +432,7 @@ func_data = struct { strings = fp, + line_num = skiplines, i = skiplines, n = length(fp), output_crlf = 0, comment_char = comment_char, @@ -377,21 +441,31 @@ } else { + variable line; if (type != File_Type) { - fp = fopen (fp, "r"); + fp = fopen (file, "r"); if (fp == NULL) - throw OpenError, "Unable to open CSV file"$; + throw OpenError, "Unable to open CSV file '$file'"$; + + % Ignore a BOM if it exists + if (-1 != fgets (&line, fp)) + { + if (0 == strnbytecmp (line, "\xEF\xBB\xBF", 3)) + () = fseek (fp, 3, SEEK_SET); + else + () = fseek (fp, 0, SEEK_SET); + } } func_data = struct { fp = fp, + line_num = skiplines, comment_char = comment_char, comment = comment, comment_len = ((comment == NULL) ? 0 : strbytelen(comment)), }; - variable line; loop (skiplines) () = fgets (&line, fp); } @@ -401,6 +475,7 @@ decoder = _csv_decoder_new (func, func_data, delim, quote, flags), readrow = &read_row, readcol = &read_cols, + func_data = func_data, }; return csv; @@ -471,10 +546,21 @@ } } - variable ncols = length(data); - if (length (data) == 0) + variable i, ncols = length(data); + if (ncols == 0) return; - variable nrows = length(data0), i, j; + + % The following assumes that data is a list or array of lists or + % array. + data = @data; + _for i (0, ncols-1, 1) + { + variable t = typeof(datai); + if ((t != List_Type) && (t != Array_Type)) + datai = datai; + } + + variable nrows = length(data0), j; _for i (1, ncols-1, 1) { if (nrows != length(datai)) @@ -573,44 +659,24 @@ set_struct_field (s, name, val); } - variable types = DataType_Typenum; _for (0, length (val)-1, 1) { variable i = (); variable type = _slang_guess_type (vali); - if (type == Double_Type) + if ((type == Double_Type) || (type == Float_Type)) { val = atof (val); return; } - typesi = type; - } - - if (all (types == Int_Type)) - { - val = atoi (val); - return; - } - - if (any (types == Float_Type)) - { - val = atofloat (val); - return; - } - - if (any (types == Long_Type)) - { - val = atol (val); - return; + if (type == String_Type) + return; + % Otherwise an integer } - if (any (types == Int_Type)) - { - val = atoi (val); - return; - } - - val = atof (val); + variable lval = atol (val); + val = atoi (val); + if (any(val != lval)) + val = lval; } define csv_readcol () @@ -643,13 +709,16 @@ % second line gives the field types. if (rdb) { - q = struct { comment = "#", delim = '\t' }; + q = struct { @q, comment = "#", delim = '\t' }; } variable types = NULL; variable csv = csv_decoder_new (file ;; q); if (rdb || qualifier_exists ("has_header")) { variable header = csv.readrow (); + if (header == NULL) + throw ReadError, "Unable to read a CSV header row"; + q = struct { header=header, @q }; if (rdb) {
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/fcntl-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/fcntl-module.c
Changed
@@ -1,4 +1,4 @@ -/* Copyright (c) 2001-2017,2018 John E. Davis +/* Copyright (c) 2001-2021,2022 John E. Davis * This file is part of the S-Lang library. * * You may distribute under the terms of either the GNU General Public
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/fork-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/fork-module.c
Changed
@@ -1,6 +1,6 @@ /* -*- mode: C; mode: fold; -*- */ /* -Copyright (C) 2009-2017,2018 John E. Davis +Copyright (C) 2009-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/help/base64funs.hlp -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/help/base64funs.hlp
Changed
@@ -163,7 +163,7 @@ variable b64 = _base64_encoder_new (&encode_callback, &s); _base64_encoder_accumulate (b64, bstr); _base64_encoder_close (b64); - return b; + return s; }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/help/chksumfuns.hlp -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/help/chksumfuns.hlp
Changed
@@ -73,3 +73,241 @@ sha1sum, md5sum_file, md5sum -------------------------------------------------------------- + +crc8sum + + SYNOPSIS + Compute an 8 bit CRC on a string + + USAGE + UChar_Type crc8sum (BString_Type bstr) + + DESCRIPTION + This function computes an 8 bit CRC for the specified string. A + number of variants that differ according to the polynomial, initial + value (seed), input/output bit reflection, and the XOR out value. + Supported variants include: + + cdma2000 ; poly=0x9B, seed=0xFF, refin=0, refout=0, xorout=0x00 + darc ; poly=0x39, seed=0x00, refin=1, refout=1, xorout=0x00 + dvb-s2 ; poly=0xD5, seed=0x00, refin=0, refout=0, xorout=0x00 + ebu ; poly=0x1D, seed=0xFF, refin=1, refout=1, xorout=0x00 + i-code ; poly=0x1D, seed=0xFD, refin=0, refout=0, xorout=0x00 + itu ; poly=0x07, seed=0x00, refin=0, refout=0, xorout=0x55 + maxim ; poly=0x31, seed=0x00, refin=1, refout=1, xorout=0x00 + rohc ; poly=0x07, seed=0xFF, refin=1, refout=1, xorout=0x00 + wcdma ; poly=0x9B, seed=0x00, refin=1, refout=1, xorout=0x00 + + The CRC-8 algorithm is specified via qualifiers. The following + specify the same CRC-8 algorthm: + + crc8 = crc8sum ("string" ; type="maxim"); + crc8 = crc8sum ("string" ; poly=0x31, refin=1, refout=1); + + The default CRC-8 algorithm is "dvb-s2". + + EXAMPLE + This example shows how to compute the Maxim CRC-8 value on a file. + + fp = fopen (file, "rb"); + c = chksum_new("crc8"; type="maxim"); + while (-1 != fread_bytes (&buf, 4096, fp) + c.accumulate (buf); + crc8 = chksum_close (); + + + NOTES + This function is part of the `chksum' module: + + require("chksum"); + + + SEE ALSO + crc16sum, crc32sum, crc8sum_file + +-------------------------------------------------------------- + +crc8sum_file + + SYNOPSIS + Compute the CRC-8 value for the contents of a file + + USAGE + UChar_Type crc8sum_file (String_Type|File_Type f) + + DESCRIPTION + The `crc8sum_file' function computes the CRC-8 sum on the + contents of a file. The file may either be specified as a string + giving the name of the file, or as an open stdio File_Type + pointer. The function returns the 8-bit CRC value. + + Qualifiers are used to specifiy the CRC-8 variant. See the + documentation for `crc8sum' function for more information. + + SEE ALSO + crc8sum, crc32sum_file, sha1sum_file + +-------------------------------------------------------------- + +crc16sum + + SYNOPSIS + Compute an 16 bit CRC on a string + + USAGE + UInt16_Type crc16sum (BString_Type bstr) + + DESCRIPTION + This function computes an 16 bit CRC for the specified string. A + number of variants that differ according to the polynomial, initial + value (seed), input/output bit reflection, and the XOR out value. + Supported variants include: + + ccitt-0 ; poly=0x1021U, seed=0xFFFFU, refin=0, refout=0, xorout=0x0000U + arc ; poly=0x8005U, seed=0x0000U, refin=1, refout=1, xorout=0x0000U + aug-ccitt ; poly=0x1021U, seed=0x1D0FU, refin=0, refout=0, xorout=0x0000U + buypass ; poly=0x8005U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U + cdma2000 ; poly=0xC867U, seed=0xFFFFU, refin=0, refout=0, xorout=0x0000U + dds-110 ; poly=0x8005U, seed=0x800DU, refin=0, refout=0, xorout=0x0000U + dect-r ; poly=0x0589U, seed=0x0000U, refin=0, refout=0, xorout=0x0001U + dect-x ; poly=0x0589U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U + dnp ; poly=0x3D65U, seed=0x0000U, refin=1, refout=1, xorout=0xFFFFU + en-13757 ; poly=0x3D65U, seed=0x0000U, refin=0, refout=0, xorout=0xFFFFU + genibus ; poly=0x1021U, seed=0xFFFFU, refin=0, refout=0, xorout=0xFFFFU + maxim ; poly=0x8005U, seed=0x0000U, refin=1, refout=1, xorout=0xFFFFU + mcrf4xx ; poly=0x1021U, seed=0xFFFFU, refin=1, refout=1, xorout=0x0000U + riello ; poly=0x1021U, seed=0xB2AAU, refin=1, refout=1, xorout=0x0000U + t10-dif ; poly=0x8BB7U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U + teledisk ; poly=0xA097U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U + tms37157 ; poly=0x1021U, seed=0x89ECU, refin=1, refout=1, xorout=0x0000U + usb ; poly=0x8005U, seed=0xFFFFU, refin=1, refout=1, xorout=0xFFFFU + a ; poly=0x1021U, seed=0xC6C6U, refin=1, refout=1, xorout=0x0000U + kermit ; poly=0x1021U, seed=0x0000U, refin=1, refout=1, xorout=0x0000U + modbus ; poly=0x8005U, seed=0xFFFFU, refin=1, refout=1, xorout=0x0000U + x-25 ; poly=0x1021U, seed=0xFFFFU, refin=1, refout=1, xorout=0xFFFFU + xmodem ; poly=0x1021U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U + + The CRC-16 algorithm is specified via qualifiers. The following + specify the same CRC-16 algorthm: + + crc16 = crc16sum ("string" ; type="arc"); + crc16 = crc16sum ("string" ; poly=0x8005U, refin=1, refout=1); + + The default CRC-16 algorithm is "ccitt-0". + + EXAMPLE + This example shows how to compute the Maxim CRC-16 value on a file. + + fp = fopen (file, "rb"); + c = chksum_new("crc16"; type="maxim"); + while (-1 != fread_bytes (&buf, 4096, fp) + c.accumulate (buf); + crc16 = chksum_close (); + + + NOTES + This function is part of the `chksum' module: + + require("chksum"); + + + SEE ALSO + crc8sum, crc32sum, crc16sum_file + +-------------------------------------------------------------- + +crc16sum_file + + SYNOPSIS + Compute the CRC-16 value for the contents of a file + + USAGE + UInt16_Type crc16sum_file (String_Type|File_Type f) + + DESCRIPTION + The `crc16sum_file' function computes the CRC-16 sum on the + contents of a file. The file may either be specified as a string + giving the name of the file, or as an open stdio File_Type + pointer. The function returns the 16-bit CRC value. + + Qualifiers are used to specifiy the CRC-16 variant. See the + documentation for `crc16sum' function for more information. + + SEE ALSO + crc16sum, crc32sum_file, sha1sum_file + +-------------------------------------------------------------- + +crc32sum + + SYNOPSIS + Compute an 32 bit CRC on a string + + USAGE + UInt32_Type crc32sum (BString_Type bstr) + + DESCRIPTION + This function computes an 32 bit CRC for the specified string. A + number of variants that differ according to the polynomial, initial + value (seed), input/output bit reflection, and the XOR out value. + Supported variants include: + +(default); poly=0x04C11DB7U, seed=0xFFFFFFFFU, refin=1, refout=1, xorout=0xFFFFFFFFU + bzip2 ; poly=0x04C11DB7U, seed=0xFFFFFFFFU, refin=0, refout=0, xorout=0xFFFFFFFFU + c ; poly=0x1EDC6F41U, seed=0xFFFFFFFFU, refin=1, refout=1, xorout=0xFFFFFFFFU + d ; poly=0xA833982BU, seed=0xFFFFFFFFU, refin=1, refout=1, xorout=0xFFFFFFFFU + mpeg-2 ; poly=0x04C11DB7U, seed=0xFFFFFFFFU, refin=0, refout=0, xorout=0x00000000U + posix ; poly=0x04C11DB7U, seed=0x00000000U, refin=0, refout=0, xorout=0xFFFFFFFFU + q ; poly=0x814141ABU, seed=0x00000000U, refin=0, refout=0, xorout=0x00000000U + jamcrc ; poly=0x04C11DB7U, seed=0xFFFFFFFFU, refin=1, refout=1, xorout=0x00000000U + xfer ; poly=0x000000AFU, seed=0x00000000U, refin=0, refout=0, xorout=0x00000000U + + The CRC-32 algorithm is specified via qualifiers. The following + specify the same CRC-32 algorthm: + + crc32 = crc32sum ("string" ; type="posix"); + crc32 = crc32sum ("string" ; poly=0x04C11DB7U, xorout=0xFFFFFFFFU); + + + EXAMPLE + This example shows how to compute the default CRC-32 value on a file. + + fp = fopen (file, "rb"); + c = chksum_new("crc32"); + while (-1 != fread_bytes (&buf, 4096, fp) + c.accumulate (buf); + crc32 = chksum_close (); + + + NOTES + This function is part of the `chksum' module: + + require("chksum"); + + + SEE ALSO + crc8sum, crc32sum, crc32sum_file + +-------------------------------------------------------------- + +crc32sum_file + + SYNOPSIS + Compute the CRC-32 value for the contents of a file + + USAGE + UInt32_Type crc32sum_file (String_Type|File_Type f) + + DESCRIPTION + The `crc32sum_file' function computes the CRC-32 sum on the + contents of a file. The file may either be specified as a string + giving the name of the file, or as an open stdio File_Type + pointer. The function returns the 32-bit CRC value. + + Qualifiers are used to specifiy the CRC-32 variant. See the + documentation for `crc32sum' function for more information. + + SEE ALSO + crc32sum, crc16sum_file, sha1sum_file + +--------------------------------------------------------------
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/help/csvfuns.hlp -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/help/csvfuns.hlp
Changed
@@ -34,11 +34,13 @@ It is important to understand the difference between a ROW and a LINE in a CSV formatted file: a row may span more than one line in a file. The `skiplines' qualifier specifies the number of LINES to be - skipped, not ROWS. + skipped, not ROWS. However, if a comment string appears at the + beginning of one of the lines forming a multiline string, it will + treated as part of the string and not as a comment. CSV files have no notion of data-types: all field values are strings. For this reason, the `type' qualifier introduces an extra layer - that is not part CSV format. + that is not part of the CSV specification. SEE ALSO csv.readcol, csv.readrow
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/help/randfuns.hlp -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/help/randfuns.hlp
Changed
@@ -335,7 +335,7 @@ rand SYNOPSIS - Generate random integers numbers + Generate random unsigned integers USAGE X = rand (Rand_Type g, ,num)
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/help/statsfuns.hlp -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/help/statsfuns.hlp
Changed
@@ -54,8 +54,8 @@ to the value of the statistic upon return. QUALIFIERS - ; mu=value: Specifies the known mean of the normal distribution. - ; sigma: Specifies the known standard deviation of the normal distribution + ; mean=value: Specifies the known mean of the normal distribution. + ; stddev=value: Specifies the known standard deviation of the normal distribution ; cdf: If present, the data will be interpreted as a CDFs of a known, but unspecified, distribution. NOTES @@ -71,7 +71,30 @@ 2004. SEE ALSO - ad_ktest, ks_test, t_test, z_test, normal_cdf, + ad_ktest, ks_test, t_test, z_test, normal_cdf + +-------------------------------------------------------------- + +cumulant + + SYNOPSIS + Compute the first n cumulants of an array + + USAGE + k1,...,kn = cumulant (X, n) + + DESCRIPTION + This function returns unbiased estimates of the first `n' + cumulants from an array `X' of samples of a probability + distribution. The cumulants are returned as an array of size + `n'. + + NOTES + The implementation currently restricts the value of n to 1, 2, 3, or 4. + The estimator of the nth cumulent is also known as the nth k-statistic. + + SEE ALSO + mean, stddev, kurtosis, skewness -------------------------------------------------------------- @@ -195,7 +218,7 @@ s = skewness (a) DESCRIPTION - This function computes the so-called skewness of the array `a'. + This function computes the skewness (g1) of the array `a'. SEE ALSO mean, stddev, kurtosis @@ -211,7 +234,7 @@ s = kurtosis (a) DESCRIPTION - This function computes the so-called kurtosis of the array `a'. + This function computes the kurtosis (g2) of the array `a'. NOTES This function is defined such that the kurtosis of the normal @@ -271,12 +294,12 @@ Compute the Poisson CDF USAGE - cdf = poisson_cdf (Double_Type m, Int_Type k) + cdf = poisson_cdf (Double_Type lambda, Int_Type k) DESCRIPTION This function computes the CDF for the Poisson probability - distribution parameterized by the value `m'. For values of - `m>100' and `abs(m-k)<sqrt(m)', the Wilson and Hilferty + distribution parameterized by the value `lambda'. For values of + `lambda>100' and `abs(lambda-k)<sqrt(lambda)', the Wilson and Hilferty asymptotic approximation is used. SEE ALSO
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/histogram-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/histogram-module.c
Changed
@@ -2,7 +2,7 @@ /* Copyright (c) 2003-2007 Massachusetts Institute of Technology - Copyright (c) 2013-2017,2018 John E. Davis <jed@jedsoft.org> + Copyright (c) 2013-2021,2022 John E. Davis <jed@jedsoft.org> This software was developed by the MIT Center for Space Research under contract SV1-61010 from the Smithsonian Institution.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/histogram.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/histogram.sl
Changed
@@ -142,7 +142,7 @@ #ifexists add_doc_file $1 = path_concat (path_concat (path_dirname (__FILE__), "help"), - "histogram.hlp"); + "histfuns.hlp"); if (NULL != stat_file ($1)) add_doc_file ($1); #endif
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/json-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/json-module.c
Changed
@@ -1,6 +1,6 @@ /* -*- mode: C; mode: fold -*- */ /* -Copyright (C) 2013-2017,2018 John E. Davis, Manfred Hanke +Copyright (C) 2013-2021,2022 John E. Davis, Manfred Hanke This file is part of the S-Lang Library. @@ -558,7 +558,7 @@ SLfree ((char *)sp); } -/* This has table implementation does not copy the strings */ +/* This hash table implementation does not copy the strings */ #define HASH_TABLE_SIZE 601 typedef struct String_Hash_Elem_Type {
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/mkfiles/makefile.all -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/mkfiles/makefile.all
Changed
@@ -145,7 +145,7 @@ # List of modules to compile. Some/Most require additional libraries to be # installed. MODULES = chksum stats slsmg rand csv base64 histogram json -CHKSUM_XOBJS = chksum_md5.$(O) chksum_sha1.$(O) +CHKSUM_XOBJS = chksum_md5.$(O) chksum_sha1.$(O) chksum_sha2.$(O) chksum_crc.$(O) STATS_XOBJS = stats_kendall.$(O) # slsmg, rand, csv base64 histogram stats: no external dependencies # iconv: iconv library @@ -186,6 +186,8 @@ chksum: $(MAKE) TARGET=chksum_md5 TARGETINCS=$(CHKSUMINCS) compile-target $(MAKE) TARGET=chksum_sha1 TARGETINCS=$(CHKSUMINCS) compile-target + $(MAKE) TARGET=chksum_sha2 TARGETINCS=$(CHKSUMINCS) compile-target + $(MAKE) TARGET=chksum_crc TARGETINCS=$(CHKSUMINCS) compile-target $(MAKE) TARGET=chksum-module TARGETLIBS=$(CHKSUMLIBS) TARGETINCS=$(CHKSUMINCS) "TARGET_XOBJS=$(CHKSUM_XOBJS)" build-target stats: $(MAKE) TARGET=stats_kendall TARGETINCS=$(STATSINCS) compile-target
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/onig-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/onig-module.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2007-2017,2018 John E. Davis +Copyright (C) 2007-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -424,12 +424,15 @@ case 4: if (NULL == (syntax = pop_onig_syntax ())) return; + /* fall through */ case 3: if (NULL == (enc = pop_onig_encoding ())) return; + /* fall through */ case 2: if (-1 == pop_onig_option (&option)) return; + /* fall through */ case 1: if (-1 == SLang_pop_slstring ((char **)&pattern)) return; @@ -516,7 +519,7 @@ case 5: if (-1 == pop_onig_option (&option)) return -1; - /* drop */ + /* fall through */ case 4: if (-1 == SLang_pop_int (&end_pos)) return -1;
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/pcre-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/pcre-module.c
Changed
@@ -1,5 +1,5 @@ /* -*- mode: C; mode: fold -*- -Copyright (C) 2010-2017,2018 John E. Davis +Copyright (C) 2010-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -137,7 +137,7 @@ case 2: if (-1 == SLang_pop_integer (&options)) return; - /* drop */ + /* fall through */ case 1: default: if (-1 == SLang_pop_slstring (&pattern)) @@ -187,12 +187,12 @@ case 4: if (-1 == SLang_pop_integer (&options)) return -1; - /* drop */ + /* fall through */ case 3: - /* drop */ + /* fall through */ if (-1 == SLang_pop_integer (&pos)) return -1; - /* drop */ + /* fall through */ default: switch (SLang_peek_at_stack()) {
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/pcre.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/pcre.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for @@ -25,7 +25,7 @@ if (typeof (re) != PCRE_Type) { variable compile_options = qualifier ("options", 0); - re = pcre_compile (re, options); + re = pcre_compile (re, compile_options); } variable n = pcre_exec (re, str, pos, options);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/png-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/png-module.c
Changed
@@ -1,6 +1,6 @@ /* -*- mode: C; mode: fold; -*- */ /* -Copyright (C) 2005-2017,2018 John E. Davis +Copyright (C) 2005-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/png.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/png.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for @@ -82,8 +82,15 @@ define png_rgb_to_gray (rgb) { - variable gray = ((rgb&0xFF) + ((rgb&0xFF00)shr 8) + ((rgb&0xFF0000)shr 16)); - return typecast ((__tmp(gray)/3.0), UChar_Type); + variable w = 1.0; + w = qualifier ("wghts", w); + if (length (w) != 3) + w = w0, w0, w0; + w /= sum(w); + if (any(isnan(w) or isinf(w))) w* = 1.0/3; + + variable gray = (w2*(rgb&0xFF) + w1*((rgb&0xFF00)shr 8) + w0*((rgb&0xFF0000)shr 16)); + return typecast (__tmp(gray), UChar_Type); } private define normalize_gray (gray, nlevels) @@ -112,8 +119,8 @@ if (g0 != g1) { - variable factor = nlevels/double(g1-g0); - gray = typecast ((gray-g0)*factor, Int_Type); + variable factor = (nlevels-1)/double(g1-g0); + gray = nint((gray-g0)*factor); graywhere (gray<0) = 0; graywhere (gray>=nlevels) = (nlevels-1); }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/rand-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/rand-module.c
Changed
@@ -1,5 +1,5 @@ /* -*- mode: C; mode: fold -*- -Copyright (C) 2007-2017,2018 John E. Davis +Copyright (C) 2007-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/rand.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/rand.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/select-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/select-module.c
Changed
@@ -1,4 +1,4 @@ -/* Copyright (c) 2010-2017,2018 John E. Davis +/* Copyright (c) 2010-2021,2022 John E. Davis * This file is part of the S-Lang library. * * You may distribute under the terms of the GNU General Public
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/slsmg-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/slsmg-module.c
Changed
@@ -1,6 +1,6 @@ /* This module implements an interface to the SLang SMG routines */ /* -*- mode: C; mode: fold -*- -Copyright (C) 2010-2017,2018 John E. Davis +Copyright (C) 2010-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/socket-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/socket-module.c
Changed
@@ -1,6 +1,6 @@ /* -*- mode: C; mode: fold; -*- */ /* - Copyright (C) 2006-2017,2018 John E. Davis + Copyright (C) 2006-2021,2022 John E. Davis * This file is part of the S-Lang Library. * @@ -545,7 +545,7 @@ int status; Host_Addr_Info_Type *hinfo; - if (-1 == pop_host_port ("connect", nargs, &host, &port)) + if (-1 == pop_host_port ("bind", nargs, &host, &port)) return -1; if (NULL == (hinfo = get_host_addr_info (host)))
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/stats-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/stats-module.c
Changed
@@ -1,6 +1,7 @@ /* -*- mode: C; mode: fold; -*- */ /* + Copyright (c) 2013-2021,2022 John E. Davis Copyright (c) 2007 Massachusetts Institute of Technology This software was developed by the MIT Center for Space Research
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/stats-module.h -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/stats-module.h
Changed
@@ -1,7 +1,7 @@ #ifndef SLSTATS_MODULE_H_ # define SLSTATS_MODULE_H_ 1 /* -Copyright (C) 2017,2018 John E. Davis +Copyright (C) 2017-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/stats.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/stats.sl
Changed
@@ -78,15 +78,15 @@ return mean (__push_args(args)); } -% These functions return the biased stddev define sample_stddev () { - variable x = (); - variable n = 1.0*length (x); - return stddev(x) * sqrt((n-1.0)/n); + % The stddev intrinsic returns the sample stddev. + % For backward compatibility, simply call it. + variable args = __pop_list (_NARGS); + return stddev (__push_list (args)); } -private define get_mean_stddev (x) +private define get_mean_and_biased_stddev (x) { variable m = mean(x); variable n = 1.0*length (x); @@ -94,13 +94,61 @@ return m, s, n; } +define cumulant () +{ + variable x, m = 0; + + if (_NARGS == 2) + (x,m) = (); + + % Only the first 4 cumulants are supported + if ((m != 1) && (m != 2) && (m != 3) && (m != 4)) + usage ("k1,..,kn = cumulant(A, n); %% n=1,2,3,4"); + + variable i, n = double(length (x)); + variable k = Double_Typem; k* = _NaN; + + if (n <= m) return k; + + variable s1, s2, s3, s4, s1_2, s1_3, s1_4, den, xm; + + den = n; + xm = x; + s1 = sum(xm); + k0 = s1/den; + if ((m == 1) || isnan(s1)) return k; + + den = den*(n-1.0); + xm = xm * x; + s2 = sum(xm); + s1_2 = s1*s1; + k1 = (n*s2-s1_2)/den; + if (m == 2) return k; + + den = den*(n-2.0); + xm = xm*x; + s3 = sum(xm); + s1_3 = s1_2*s1; + k2 = (2*s1_3 - n*(3*s1*s2 - n*s3))/den; + if (m == 3) return k; + + den = den*(n-3.0); + xm = xm*x; + s4 = sum(xm); + s1_4 = s1_3*s1; + k3 = (-6*s1_4 + n*s2*(12*s1_2 - 3*(n-1)*s2) + -n*(n+1)*(4*s1*s3 - n*s4))/den; + return k; +} + +% Returns the skewness (Wikipedia g1) define skewness () { if (_NARGS != 1) usage ("s = %s(A);", _function_name ()); variable x = (); variable m, s, n; - (m, s, n) = get_mean_stddev (x); + (m, s, n) = get_mean_and_biased_stddev (x); x = sum (((x - m)/s)^3)/n; @@ -116,7 +164,7 @@ usage ("s = %s(A);", _function_name ()); variable x = (); variable m, s, n; - (m, s, n) = get_mean_stddev (x); + (m, s, n) = get_mean_and_biased_stddev (x); x = sum (((x - m)/s)^4)/n - 3.0; @@ -423,7 +471,7 @@ (x,y,tref) = (); else { - usage ("p = welch_t_test2 (X, Y ,&t ; qualifiers); %% Welch's 2 sample t-test\n" + usage ("p = welch_t_test (X, Y ,&t ; qualifiers); %% Welch's 2 sample t-test\n" + "Qualifiers:\n" + " side=\"<\" | \">\"" );
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/stats_kendall.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/stats_kendall.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2017,2018 John E. Davis +Copyright (C) 2020-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/statslib/ad_test.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/statslib/ad_test.sl
Changed
@@ -255,6 +255,7 @@ variable i, j, a, zz; + % Evaluate adinf(z) i = where (0.0 < z < 2.0, &j); if (length (i)) { @@ -315,8 +316,10 @@ usage ("\ p = ad_test (X ,&Asquared);\n\ %% 1-sample Anderson-Darling test\n\ Qualifiers:\n\ - ;cdf %% The X values are the CDFs of the underlying distribution\n\ - %% and 0 <= X <= 1\n\ + ;cdf %% The X values are the CDFs of the underlying distribution\n\ + %% and 0 <= X <= 1\n\ + ;mean=val %% The mean of the assumed normal distribution\n\ + ;stddev=val %% The stddev of the assumed normal distribution\n\ " ); @@ -350,8 +353,6 @@ variable ii = 1:2*n:2; variable a2 = -n - (sum(ii*log(cdf) + (2*n-ii)*log(1.0-cdf)))/n; - a2 = factor * a2; - if (s_ref != NULL) @s_ref = a2; @@ -359,6 +360,7 @@ { return 1.0 - anderson_darling_cdf (a2, n); } + a2 = factor * a2; % Augostino & Stephens, 1986 if (a2 >= 0.6)
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/statslib/ks_test.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/statslib/ks_test.sl
Changed
@@ -44,8 +44,8 @@ % private define ks_test2_prob () { - if (_NARGS != 3) - usage ("p = %s(m, n, d); %% P(D_mn >= d)", _function_name ()); + %if (_NARGS != 3) + % usage ("p = %s(m, n, d); %% P(D_mn >= d)", _function_name ()); variable d, m, n; (m, n, d) = (); % See the above note for why 1 is subtracted for the first argument of
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/sysconf-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/sysconf-module.c
Changed
@@ -1,6 +1,6 @@ /* -*- mode: C; mode: fold; -*- */ /* -Copyright (C) 2009-2017,2018 John E. Davis +Copyright (C) 2009-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/termios-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/termios-module.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2010-2017,2018 John E. Davis +Copyright (C) 2010-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -101,7 +101,8 @@ } #define DO_SYSCALL_0(fun, f) do_syscall_0((int(*)(int))(fun),(f)) -#define DO_SYSCALL_1(fun, f, i) do_syscall_1((int(*)(int,int))(fun),(f),(i)) +/* #define DO_SYSCALL_1(fun, f, i) do_syscall_1((int(*)(int,int))(fun),(f),(i)) */ +#define DO_SYSCALL_1(fun, f, i) do_syscall_1((fun),(f),(i)) #define DO_SYSCALL_STRUCT_1(fun, f, s) \ do_syscall_struct_1((int(*)(int, void*))(fun), (f), (void*)(s)) #define DO_SYSCALL_STRUCT_2(fun, f, i, s) \ @@ -129,7 +130,18 @@ static int tcsetpgrp_intrin (SLFile_FD_Type *f, int *id) { - return DO_SYSCALL_1 (tcgetpgrp, f, *id); + /* In case sizeof(pid_t) is not the same as sizeof(int), inline this */ + int fd; + int ret; + + if (-1 == SLfile_get_fd (f, &fd)) + return -1; + + while ((-1 == (ret = tcsetpgrp (fd, *id))) + && (0 == check_and_set_errno (errno))) + ; + + return ret; } static int tcsendbreak_intrin (SLFile_FD_Type *f, int *action)
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/test/runtests.sh -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/test/runtests.sh
Changed
@@ -9,17 +9,36 @@ export DYLD_LIBRARY_PATH="$ROOT/src/${ARCH}elfobjs" run_test_pgm="$SLSHROOT/${ARCH}objs/slsh_exe -n -g" -#run_test_pgm="$SLSHROOT/${ARCH}objs/slsh_exe -n -g $SLSHROOT/scripts/sldb" runprefix="$SLTEST_RUN_PREFIX" -#runprefix="valgrind --tool=memcheck --leak-check=yes --error-limit=no --num-callers=25" -#runprefix="gdb --args" +use_slcov=0 +while "$#" -ge 1 +do + case "$1" in + "--slcov" ) runsuffix="$SLSHROOT/scripts/slcov"; shift + rm -f test_*.slcov* + use_slcov=1 + ;; + "--sldb" ) runsuffix="$SLSHROOT/scripts/sldb"; shift + ;; + "--gdb" ) runprefix="gdb --args"; shift + ;; + "--memcheck" ) runprefix="valgrind --tool=memcheck --leak-check=yes --error-limit=no --num-callers=25" + shift + ;; + "--strace" ) runprefix="strace -f -o strace.log" + shift + ;; + * ) break + ;; + esac +done ######################################################################## if $# -eq 0 then - echo "Usage: $0 test1.sl test2.sl ..." + echo "Usage: $0 --gdb|--sldb|--slcov|--memcheck test1.sl test2.sl ..." exit 64 fi @@ -29,9 +48,10 @@ n_failed=0 tests_failed="" + for testxxx in $@ do - $runprefix $run_test_pgm $testxxx + $runprefix $run_test_pgm $runsuffix $testxxx if $? -ne 0 then @@ -44,6 +64,15 @@ if $n_failed -eq 0 then echo "All tests passed." + if $use_slcov -eq 1 + then + lcov_merge_args="" + for X in test_*.slcov* + do + lcov_merge_args="$lcov_merge_args -a $X" + done + lcov $lcov_merge_args -o "modules.slcov" + fi else echo "$n_failed tests failed: $tests_failed" fi
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/test/test_chksum.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/test/test_chksum.sl
Changed
@@ -3,33 +3,54 @@ private variable Chksum_Map = Assoc_Type; -private define add_entry (str, md5, sha1) +private define add_entry (str, md5, sha1, + sha224, sha256, sha384, sha512) { Chksum_Mapstr = struct { md5 = md5, sha1 = sha1, + sha224 = sha224, + sha256 = sha256, + sha384 = sha384, + sha512 = sha512, }; } add_entry ("", "d41d8cd98f00b204e9800998ecf8427e", - "da39a3ee5e6b4b0d3255bfef95601890afd80709" + "da39a3ee5e6b4b0d3255bfef95601890afd80709", + "d14a028c2a3a2bc9476102bb288234c415a2b01f828ea62ac5b3e42f", + "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855", + "38b060a751ac96384cd9327eb1b1e36a21fdb71114be07434c0cc7bf63f6e1da274edebfe76f65fbd51ad2f14898b95b", + "cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e" ); add_entry ("1", "c4ca4238a0b923820dcc509a6f75849b", - "356a192b7913b04c54574d18c28d46e6395428ab" + "356a192b7913b04c54574d18c28d46e6395428ab", + "e25388fde8290dc286a6164fa2d97e551b53498dcbf7bc378eb1f178", + "6b86b273ff34fce19d6b804eff5a3f5747ada4eaa22f1d49c01e52ddb7875b4b", + "47f05d367b0c32e438fb63e6cf4a5f35c2aa2f90dc7543f8a41a0f95ce8a40a313ab5cf36134a2068c4c969cb50db776", + "4dff4ea340f0a823f15d3f4f01ab62eae0e5da579ccb851f8db9dfe84c58b2b37b89903a740e1ee172da793a6e79d560e5f7f9bd058a12a280433ed6fa46510a" ); add_entry ("Four score and seven years ago", "8bc88284b17081c54df4daa4576251f7", - "0e6089220e01abfc69188c555f1a37201d2fa37f" + "0e6089220e01abfc69188c555f1a37201d2fa37f", + "5016349562f610749f5e34b105e48b55e2fb3aed3f81fd0572f066fd", + "213742bd59f1d8fe848b6ea94647dd465310b8d816234d5a952dc645fa320707", + "8d18c7eb4e4ccaaf18f6e7b9566d97e2a81d0838e704e8d9da1cb7461efa44165fe9ad5510f2dafa630f1de8b32d0a42", + "c9e9b19978e48a2d3031bfc411f60ab1d89e5ccfb9fabbc0ec135c14aa54568ca051e96ed07a5d0c7c3704f7f3189a631008734b4ce6ee1d87e97384aea21fe7" ); add_entry ("Four score and seven years ago our fathers brought forth on this continent a new nation, conceived in liberty, and dedicated to the proposition that all men are created equal.", "73168f4191456bc526791a83c064997b", - "3eabb94199e5347c55ae914ef75803ff0970d9e4" + "3eabb94199e5347c55ae914ef75803ff0970d9e4", + "0b85933f2cf20d16c0158e46b101386b5f791a360b9590f053369a58", + "16b7310f53d595aa0cad0cbe8c4fe3e8ae4c71d21faae9ee0ac84530d759beea", + "d8f207a10e97415c2147f8702a5a1cd93239aa2dbdd8c6c23da9723929b189e65a1c9e5aae79d8161c736bbfec94b617", + "2a4a49becf6865588cf7fab5f3fee94a4fd2cbcc19fa6202d6be153360992ad0a8993a14a44429035cc3377dd22e1bfafb09f5e5625f3fe7654c2fdfbb3e6cfb" ); private define test_accumulate (name, str, chksum) @@ -82,9 +103,7 @@ variable md5 = md5sum (key); if (md5 != s.md5) failed ("MD5 failure for %s, got %s instead of %s", key, md5, s.md5); - test_accumulate ("md5", key, md5); - md5 = test_chksum_file (&md5sum_file, key); if (md5 != s.md5) failed ("md5sum_file failed: got %s, expected %s", md5, s.md5); @@ -92,13 +111,50 @@ variable sha1 = sha1sum (key); if (sha1 != s.sha1) failed ("SHA1 failure for %s, got %s instead of %s", key, sha1, s.sha1); - test_accumulate ("sha1", key, sha1); - sha1 = test_chksum_file (&sha1sum_file, key); if (sha1 != s.sha1) failed ("sha1sum_file failed: got %s, expected %s", sha1, s.sha1); + + variable sha224 = sha224sum (key); + if (sha224 != s.sha224) + failed ("sha224 failure for %s, got %s instead of %s", key, sha224, s.sha224); + test_accumulate ("sha224", key, sha224); + sha224 = test_chksum_file (&sha224sum_file, key); + if (sha224 != s.sha224) + failed ("sha224sum_file failed: got %s, expected %s", sha224, s.sha224); + + variable sha256 = sha256sum (key); + if (sha256 != s.sha256) + failed ("sha256 failure for %s, got %s instead of %s", key, sha256, s.sha256); + test_accumulate ("sha256", key, sha256); + sha256 = test_chksum_file (&sha256sum_file, key); + if (sha256 != s.sha256) + failed ("sha256sum_file failed: got %s, expected %s", sha256, s.sha256); + + variable sha384 = sha384sum (key); + if (sha384 != s.sha384) + failed ("sha384 failure for %s, got %s instead of %s", key, sha384, s.sha384); + test_accumulate ("sha384", key, sha384); + sha384 = test_chksum_file (&sha384sum_file, key); + if (sha384 != s.sha384) + failed ("sha384sum_file failed: got %s, expected %s", sha384, s.sha384); + + variable sha512 = sha512sum (key); + if (sha512 != s.sha512) + failed ("sha512 failure for %s, got %s instead of %s", key, sha512, s.sha512); + test_accumulate ("sha512", key, sha512); + sha512 = test_chksum_file (&sha512sum_file, key); + if (sha512 != s.sha512) + failed ("sha512sum_file failed: got %s, expected %s", sha512, s.sha512); } + + if (md5sum_new().name != "md5") failed ("md5sum_new"); + if (sha1sum_new().name != "sha1") failed ("sha1sum_new"); + if (sha224sum_new().name != "sha224") failed ("sha224sum_new"); + if (sha256sum_new().name != "sha256") failed ("sha256sum_new"); + if (sha384sum_new().name != "sha384") failed ("sha384sum_new"); + if (sha512sum_new().name != "sha512") failed ("sha512sum_new"); } define slsh_main ()
View file
_service:tar_scm:slang-2.3.3.tar.bz2/modules/test/test_crc.sl
Added
@@ -0,0 +1,173 @@ +() = evalfile ("./test.sl"); +require ("chksum"); + +private variable CRC8_Map = Assoc_Type; +private variable CRC16_Map = Assoc_Type; +private variable CRC32_Map = Assoc_Type; + +private define addcrc (map, name,r0,r1,poly,seed,refin,refout,xorout) +{ + mapname = struct + { + s0 = "Four score and seven years ago", + s1 = "123456789", + r0 = r0, + r1 = r1, + poly = poly, + seed = seed, + refin = refin, + refout = refout, + xorout = xorout, + }; +} + +private define addcrc8(name,r0,r1,poly,seed,refin,refout,xorout) +{ + addcrc (CRC8_Map, name,r0,r1,poly,seed,refin,refout,xorout); +} + +addcrc8("CRC-8", 0x3EU, 0xBCU, 0xD5U, 0x00U, 0, 0, 0x00U); +addcrc8("CRC-8/CDMA2000", 0xE6U, 0xDAU, 0x9BU, 0xFFU, 0, 0, 0x00U); +addcrc8("CRC-8/DARC", 0x4DU, 0x15U, 0x39U, 0x00U, 1, 1, 0x00U); +addcrc8("CRC-8/DVB-S2", 0x3EU, 0xBCU, 0xD5U, 0x00U, 0, 0, 0x00U); +addcrc8("CRC-8/EBU", 0x1FU, 0x97U, 0x1DU, 0xFFU, 1, 1, 0x00U); +addcrc8("CRC-8/I-CODE", 0x00U, 0x7EU, 0x1DU, 0xFDU, 0, 0, 0x00U); +addcrc8("CRC-8/ITU", 0xB5U, 0xA1U, 0x07U, 0x00U, 0, 0, 0x55U); +addcrc8("CRC-8/MAXIM", 0x98U, 0xA1U, 0x31U, 0x00U, 1, 1, 0x00U); +addcrc8("CRC-8/ROHC", 0xC4U, 0xD0U, 0x07U, 0xFFU, 1, 1, 0x00U); +addcrc8("CRC-8/WCDMA", 0xDCU, 0x25U, 0x9BU, 0x00U, 1, 1, 0x00U); + +private define addcrc16(name,r0,r1,poly,seed,refin,refout,xorout) +{ + addcrc (CRC16_Map, name,r0,r1,poly,seed,refin,refout,xorout); +} + +addcrc16("CRC-16", 0x8FAAU, 0x29B1U, 0x1021U, 0xFFFFU, 0, 0, 0x0000U); +addcrc16("CRC-16/CCITT-0", 0x8FAAU, 0x29B1U, 0x1021U, 0xFFFFU, 0, 0, 0x0000U); +addcrc16("CRC-16/ARC", 0xE78CU, 0xBB3DU, 0x8005U, 0x0000U, 1, 1, 0x0000U); +addcrc16("CRC-16/AUG-CCITT", 0x54A3U, 0xE5CCU, 0x1021U, 0x1D0FU, 0, 0, 0x0000U); +addcrc16("CRC-16/BUYPASS", 0xC772U, 0xFEE8U, 0x8005U, 0x0000U, 0, 0, 0x0000U); +addcrc16("CRC-16/CDMA2000", 0xA2C5U, 0x4C06U, 0xC867U, 0xFFFFU, 0, 0, 0x0000U); +addcrc16("CRC-16/DDS-110", 0x475BU, 0x9ECFU, 0x8005U, 0x800DU, 0, 0, 0x0000U); +addcrc16("CRC-16/DECT-R", 0x9854U, 0x007EU, 0x0589U, 0x0000U, 0, 0, 0x0001U); +addcrc16("CRC-16/DECT-X", 0x9855U, 0x007FU, 0x0589U, 0x0000U, 0, 0, 0x0000U); +addcrc16("CRC-16/DNP", 0x5F10U, 0xEA82U, 0x3D65U, 0x0000U, 1, 1, 0xFFFFU); +addcrc16("CRC-16/EN-13757", 0x0D60U, 0xC2B7U, 0x3D65U, 0x0000U, 0, 0, 0xFFFFU); +addcrc16("CRC-16/GENIBUS", 0x7055U, 0xD64EU, 0x1021U, 0xFFFFU, 0, 0, 0xFFFFU); +addcrc16("CRC-16/MAXIM", 0x1873U, 0x44C2U, 0x8005U, 0x0000U, 1, 1, 0xFFFFU); +addcrc16("CRC-16/MCRF4XX", 0x24BCU, 0x6F91U, 0x1021U, 0xFFFFU, 1, 1, 0x0000U); +addcrc16("CRC-16/RIELLO", 0x0FB0U, 0x63D0U, 0x1021U, 0xB2AAU, 1, 1, 0x0000U); +addcrc16("CRC-16/T10-DIF", 0xD885U, 0xD0DBU, 0x8BB7U, 0x0000U, 0, 0, 0x0000U); +addcrc16("CRC-16/TELEDISK", 0x3CEFU, 0x0FB3U, 0xA097U, 0x0000U, 0, 0, 0x0000U); +addcrc16("CRC-16/TMS37157", 0x8A0CU, 0x26B1U, 0x1021U, 0x89ECU, 1, 1, 0x0000U); +addcrc16("CRC-16/USB", 0x578DU, 0xB4C8U, 0x8005U, 0xFFFFU, 1, 1, 0xFFFFU); +addcrc16("CRC-16/A", 0xCE93U, 0xBF05U, 0x1021U, 0xC6C6U, 1, 1, 0x0000U); +addcrc16("CRC-16/KERMIT", 0x86E8U, 0x2189U, 0x1021U, 0x0000U, 1, 1, 0x0000U); +addcrc16("CRC-16/MODBUS", 0xA872U, 0x4B37U, 0x8005U, 0xFFFFU, 1, 1, 0x0000U); +addcrc16("CRC-16/X-25", 0xDB43U, 0x906EU, 0x1021U, 0xFFFFU, 1, 1, 0xFFFFU); +addcrc16("CRC-16/XMODEM", 0xA5EFU, 0x31C3U, 0x1021U, 0x0000U, 0, 0, 0x0000U); + +private define addcrc32(name,r0,r1,poly,seed,refin,refout,xorout) +{ + addcrc (CRC32_Map, name,r0,r1,poly,seed,refin,refout,xorout); +} +addcrc32("CRC-32", 0x3CFE93B8U, 0xCBF43926U, 0x04C11DB7U, 0xFFFFFFFFU, 1, 1, 0xFFFFFFFFU); +addcrc32("CRC-32/BZIP2", 0x1CFC038AU, 0xFC891918U, 0x04C11DB7U, 0xFFFFFFFFU, 0, 0, 0xFFFFFFFFU); +addcrc32("CRC-32/C", 0xA3E98C0DU, 0xE3069283U, 0x1EDC6F41U, 0xFFFFFFFFU, 1, 1, 0xFFFFFFFFU); +addcrc32("CRC-32/D", 0x40A73E0DU, 0x87315576U, 0xA833982BU, 0xFFFFFFFFU, 1, 1, 0xFFFFFFFFU); +addcrc32("CRC-32/MPEG-2", 0xE303FC75U, 0x0376E6E7U, 0x04C11DB7U, 0xFFFFFFFFU, 0, 0, 0x00000000U); +addcrc32("CRC-32/POSIX", 0x4E7FDC75U, 0x765E7680U, 0x04C11DB7U, 0x00000000U, 0, 0, 0xFFFFFFFFU); +addcrc32("CRC-32/Q", 0x099A5C02U, 0x3010BF7FU, 0x814141ABU, 0x00000000U, 0, 0, 0x00000000U); +addcrc32("CRC-32/JAMCRC", 0xC3016C47U, 0x340BC6D9U, 0x04C11DB7U, 0xFFFFFFFFU, 1, 1, 0x00000000U); +addcrc32("CRC-32/XFER", 0x636909D5U, 0xBD0BE338U, 0x000000AFU, 0x00000000U, 0, 0, 0x00000000U); + +private define test_crc_file (func, data) +{ + variable tmpfile = sprintf ("/tmp/test_crc_%d_%d", getpid(), _time()); + variable fp = fopen (tmpfile, "wb"); + if (fp == NULL) + return; + () = fwrite (data, fp); + () = fclose (fp); + variable s = (@func)(tmpfile;; __qualifiers); + () = remove (tmpfile); + return s; +} + + +private define check_crcmap (type, map, sumfunc, sumfile) +{ + foreach (assoc_get_keys (map)) + { + variable key = (); + variable s = mapkey; + + variable cs, r; + + cs = chksum_new (type; seed=s.seed, poly=s.poly, + refin=s.refin, refout=s.refout, xorout=s.xorout); + cs.accumulate (s.s0); + r = cs.close(); + if (r != s.r0) + { + failed ("%S `%S' produced 0x%X, expected 0x%X", + key, s.s0, r, s.r0); + } + + cs = chksum_new (key); + cs.accumulate (s.s0); + r = cs.close(); + if (r != s.r0) + { + failed ("%S as key `%S' produced 0x%X, expected 0x%X", + key, s.s0, r, s.r0); + } + + cs = chksum_new (type; seed=s.seed, poly=s.poly, + refin=s.refin, refout=s.refout, xorout=s.xorout); + foreach (s.s1) + { + variable ch = (); + cs.accumulate (char(ch)); + } + r = cs.close(); + if (r != s.r1) + { + failed ("%S `%S' produced 0x%X, expected 0x%X", + key, s.s1, r, s.r1); + } + + r = (@sumfunc)(s.s1; + seed=s.seed, poly=s.poly, + refin=s.refin, refout=s.refout, xorout=s.xorout); + if (r != s.r1) + { + failed ("sumfunc=%S", sumfunc); + } + + r = test_crc_file (sumfile, s.s1; + seed=s.seed, poly=s.poly, + refin=s.refin, refout=s.refout, xorout=s.xorout); + if (r != s.r1) + failed ("sumfile=%S", sumfile); + } +} + +private define test_module (module_name) +{ + testing_module (module_name); + check_crcmap ("crc8", CRC8_Map, &crc8sum, &crc8sum_file); + check_crcmap ("crc16", CRC16_Map, &crc16sum, &crc16sum_file); + check_crcmap ("crc32", CRC32_Map, &crc32sum, &crc32sum_file); + + if (crc8_new().name != "crc8") failed ("crc8_new"); + if (crc16_new().name != "crc16") failed ("crc16_new"); + if (crc32_new().name != "crc32") failed ("crc32_new"); +} + +define slsh_main () +{ + test_module ("chksum/crc"); + end_test (); +} +
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/test/test_csv.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/test/test_csv.sl
Changed
@@ -29,20 +29,18 @@ { variable names = get_struct_field_names (Table); - variable table = csv_readcol (file;has_header); - + variable table = csv_readcol (file; has_header, init_size=1); if (any(names != get_struct_field_names (table))) { - failed ("csv_read/write failed to produce a table with the expected column names"); + failed ("1: csv_read/write failed to produce a table with the expected column names"); return; } - foreach (names) { variable name = (); ifnot (_eqs(get_struct_field (table, name), get_struct_field (table, name))) { - failed ("column %S entries are not equal", name); + failed ("1: column %S entries are not equal", name); return; } } @@ -56,7 +54,28 @@ table = csv_readcol (file, 1, 3; has_header); if (any(names1,3-1 != get_struct_field_names (table))) { - failed ("csv_read/write failed to produce a table with the expected column names"); + failed ("2: csv_read/write failed to produce a table with the expected column names"); + return; + } + foreach (get_struct_field_names (table)) + { + name = (); + ifnot (_eqs(get_struct_field (table, name), get_struct_field (table, name))) + { + failed ("2: column %S entries are not equal", name); + return; + } + } + + if (typeof(file) == File_Type) + { + clearerr (file); + () = fseek (file, 0, SEEK_SET); + } + table = csv_readcol (file, names2, names0; has_header); + if (any(names2,0 != get_struct_field_names (table))) + { + failed ("3: csv_read/write failed to produce a table with the expected column names"); return; } foreach (get_struct_field_names (table)) @@ -64,12 +83,101 @@ name = (); ifnot (_eqs(get_struct_field (table, name), get_struct_field (table, name))) { - failed ("column %S entries are not equal", name); + failed ("3: column %S entries are not equal", name); return; } } } +private define test_empty_file (file) +{ + variable s = struct + { + col1name = String_Type0, col2name = Int_Type 0, col3name = Float_Type0, + }; + csv_writecol (file, s); + variable s1 = csv_readcol (file; has_header, type2='i', type3='f'); + + ifnot (_eqs(s, s1)) + { + failed ("csv_read/writecol for a file with no rows"); + } + + () = open (file, O_WRONLY|O_TRUNC); + s1 = csv_readcol (file; header=get_struct_field_names(s), type="sif"); + ifnot (_eqs(s, s1)) + { + failed ("csv_read/writecol for empty file failed"); + } + +} + +private define test_embedded_cr (file) +{ + variable fp = fopen (file, "w"); + variable f0 = "ABC\rDEF", f1 = `quot\r,ed"`, f2 = "\rXYZ"; + () = fprintf (fp, "%S,\"%S\"\",%S\n", f0, f1, f2); + () = fclose (fp); + variable s = csv_readcol (file); + if (3 != length (get_struct_field_names (s))) + { + failed ("test_embedded_cr: wrong num fields"); + } + if ((s.col10 != f0) || (s.col20 != f1) || (s.col30 != f2)) + { + failed ("test_embedded_cr: column values do not match"); + } +} + + +private define test_embedded_comments (file) +{ + variable fp = fopen (file, "w"); + () = fputs (` +#comment line +name +"Value +#1" +#another comment +Value #2 +`, + fp); + () = fclose (fp); + variable s = csv_readcol (file; has_header, comment="#"); + if (length (s.name) != 2) + failed ("test_embedded_comments: expected 2 rows"); + if (s.name0 != "Value\n#1") + failed ("test_embedded_comments: value 1 incorrect"); + if (s.name1 != "Value #2") + failed ("test_embedded_comments: value 2 incorrect"); +} + +private define test_rdb (file) +{ + variable n = 10; + variable x = 0:2*PI:#n; + variable s0 = struct + { + idx = 1:n, x = x, sinx = sin(x), fsinx, + }; + variable fsinx = typecast (s0.sinx, Float_Type); + s0.fsinx = fsinx; + + csv_writecol (file, s0; rdb); + variable s1 = csv_readcol (file; rdb, type4='f'); + ifnot (_eqs (s0, s1)) + { + failed ("rdb 1"); + } + + s1 = csv_readcol (file; rdb, type='A', type4='f'); + ifnot (_eqs (s0, s1)) + { + failed ("rdb 2"); + } +} + + define slsh_main () { testing_module ("csv"); @@ -78,6 +186,11 @@ csv_writecol (file, Table); test_csv (file); test_csv (fopen (file, "r")); + test_csv (fgetslines (fopen (file, "r"))); + test_empty_file (file); + test_embedded_comments (file); + test_embedded_cr (file); + test_rdb (file); () = remove (file); end_test (); }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/test/test_hist.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/test/test_hist.sl
Changed
@@ -364,9 +364,58 @@ catch InvalidParmError:; } +private define check_usage (fun) +{ + try + { + (@fun)(); + } + catch UsageError; +} + +private define test_whist () +{ + variable grid = 0:9; + variable pts = 10*urand (20); + variable wghts = Double_Typelength(pts); + wghtswhere (5 <= pts < 6) = 7.5; + variable h = whist1d (pts, wghts, grid); + % We expect h=0, except for h5. + variable i = where (grid5 <= pts < grid6); + variable hexp = Double_Type10; hexp5 = 7.5*length(i); + ifnot (_eqs (h, hexp)) + { + failed ("whist1d 1"); + } + + variable nx = 10, ny = 20, xgrid = 0:nx-1, ygrid = 0:ny-1; + variable xpts = nx*urand(10000); + variable ypts = ny*urand(10000); + wghts = Double_Typelength(xpts); + i = where ((5 <= xpts < 7) and (2 <= ypts < 3)); + wghtsi = 7.1; + hexp = Double_Typenx, ny; + hexp5,2 = 7.1*length(where((5<=xpts<6)and(2<=ypts<3))); + hexp6,2 = 7.1*length(where((6<=xpts<7)and(2<=ypts<3))); + variable r; + h = whist2d (xpts, ypts, wghts, xgrid, ygrid, &r); + ifnot (_eqs(h, hexp)) + failed ("whist2d 1"); + + variable xgrid1 = 0,2,4,5,7:nx-1:2; + h = hist2d_rebin (xgrid1, ygrid, xgrid, ygrid, h); + if (h3,2 != (hexp5,2 + hexp6,2)) + failed ("hist2d_rebin"); + + check_usage (&whist2d); + check_usage (&whist1d); + check_usage (&hist2d_rebin); +} + define slsh_main () { test_module ("hist"); test_badgrids (); + test_whist (); end_test (); }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/test/test_pcre.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/test/test_pcre.sl
Changed
@@ -18,6 +18,10 @@ if (ans != eans) failed ("pcre_exec(%s) matched '%s, expected '%s'", slpat, ans, eans); + + variable matches = pcre_matches (pat, str); + if ((matches == NULL) || (matches0 != eans)) + failed ("pcre_matches"); } define slsh_main ()
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/test/test_png.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/test/test_png.sl
Changed
@@ -40,10 +40,68 @@ } } +private define test_colormaps () +{ + variable cmap_names = png_get_colormap_names(); + + if (length (cmap_names) == 0) + failed ("png_get_colormap_names: no color maps found"); + + variable cmap_name, cmap; + + foreach cmap_name (cmap_names) + { + try + { + cmap = png_get_colormap (cmap_name); + if (cmap == NULL) throw DataError; + } + catch AnyError: failed ("png_get_colormap %s failed", cmap_name); + } + + variable rgb = 0x80A0B0C0; + if (png_rgb_get_r (rgb) != 0xA0) failed ("png_get_r failed"); + if (png_rgb_get_g (rgb) != 0xB0) failed ("png_get_g failed"); + if (png_rgb_get_b (rgb) != 0xC0) failed ("png_get_b failed"); + + % A single value or array of identical values map to 127 + rgb = png_gray_to_rgb (0x80); + if (rgb != 0x7F7F7F) failed ("png_gray_to_rgb: %X vs %X", rgb, 0x808080); + + variable img = typecast (64, 128, UChar_Type); + rgb = png_gray_to_rgb (img); + % This should map to 0,255 + ifnot (_eqs(rgb, 0,0xFFFFFF)) + failed ("png_gray_to_rgb(64,128)"); + + variable gray = png_rgb_to_gray (0x808080); + if (gray != 0x80) failed ("png_rgb_to_gray 1"); + + gray = png_rgb_to_gray (0x200000; wghts=1.0,0,0); + if (gray != 0x20) failed ("png_rgb_to_gray 2"); + + variable r = UChar_Type256, g = @r, b = @r; + r0:127 = 0x20; r128: = 0xAA; + g0:127 = 0x40; g128: = 0xBB; + b0:127 = 0x60; b128: = 0xCC; + rgb = (r<<16)|(g<<8)|b; + png_add_colormap ("testmap", rgb); + variable badvalue = rgb0; + + gray = 0:255*1.0; + gray0x80 = _NaN; % bad pixel + rgb = png_gray_to_rgb (gray, "testmap"); + if ((rgb64 != 0x204060) + || (rgb200 != 0xAABBCC) + || (rgb0x80 != badvalue)) + failed ("png_gray_to_rgb with testmap"); +} + define slsh_main () { testing_module ("png"); test_png (); + test_colormaps (); end_test (); }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/test/test_rand.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/test/test_rand.sl
Changed
@@ -345,6 +345,34 @@ } } +private define test_rand_usage_forms () +{ + variable g = rand_new (_time(), getpid()); + variable imin = 12, imax = 15, r; + + r = rand_int (imin, imax); + ifnot (imin <= r <= imax) + failed ("rand_int form 1"); + r = rand_int (imin, imax, 0); + if (length (r) != 0) + failed ("rand_int form 2a"); + r = rand_int (imin, imax, 20); + if (length (r) != 20) + failed ("rand_int form 2b"); + r = rand_int (g, imin, imax, 10); + if (length (r) != 10) + failed ("rand_int form 3"); + r = rand_int (g, imin, imax); + ifnot (imin <= r <= imax) + failed ("rand_int form 4"); + try + { + rand_int (); + failed ("rand_int usage"); + } + catch UsageError; +} + define slsh_main () { testing_module ("rand"); @@ -369,5 +397,7 @@ test_rand_int (); test_rand_exp (); + test_rand_usage_forms (); + end_test (); }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/test/test_stats.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/test/test_stats.sl
Changed
@@ -1,5 +1,69 @@ () = evalfile("./test.sl"); -require ("stats.sl"); +require ("stats"); +require ("rand"); + +private define round_to_sigfig (x, n) +{ + if ((x == 0) || (n <= 0)) return x; + variable s = 1; + if (x < 0) + { + x = -x; + s = -1; + } + + % Convert x to exponential form + % x = a*10^b + % where 0.1 <= a < 1.0 ==> -1 <= log10(a) < 0 + % ==> log10(x) = log10(a) + b + % ==> -1 <= log10(x) - b < 0 + % ==> log10(x) < b <= log10(x) + 1 + % Since b is an integer, round log10(x) up to an integer + variable b = int (ceil(log10(x))); + % Given b: + % log10(x) - b = log10(a) + % ==> a = x * 10^(-b); + % + % Since 0.1 <= a < 1.0, write: + % x = (a*10^n)*10^(b-n) + % x = a'*10^(b-n), where a' = a*10^n = x*10^(n-b) + % Then 0.1*10^n <= a' < 10^n + % Or: 10^(n-1) <= a' < 10^n + % Round a' to the nearest integer. + variable p1, p2, a; + p1 = 10^b; p2 = 10^n; % to avoid under/overflow don't combine p1/p2 + a = int (0.5 + (x/p1)*p2); + return s*(a/p2)*p1; +} + +% Many of the books with examples used to validate the tests only +% provide values to a given number of significant figures. +private define sigeq (x, y, n) +{ + x = round_to_sigfig (x,n); + y = round_to_sigfig (y,n); + return feqs (x,y,1e-4,1e-8); +} + +private define generate_data (m, s, n) +{ + variable x = m + rand_gauss (s, n); + variable m0 = mean(x); + x = x + (m-m0); + variable s0 = stddev(x); + x = m + (x-m)*s/s0; + return x; +} + +private define check_usage (ref) +{ + try + { + (@ref)(); + failed ("%S usage", ref); + } + catch UsageError; +} private define test_chisqr_test () { @@ -21,14 +85,14 @@ p = chisqr_test (16,14., 14,6., 13,10., 13,8., &t); if (abs(t - 1.524) > 0.01) failed ("chisqr_test: Expected 1.524, got t=%S", t); + + check_usage (&chisqr_test); } private define test_f () { variable x, y, s, p; variable s0, p0; - %variable x = 41, 34, 33, 36, 40, 25, 31, 37, 34, 30, 38; - %variable y = 52, 57, 62, 55, 64, 57, 56, 55; % This test comes from the Gnumeric documentation for the f-test x = 68.5, 83, 83, 66.5, 58.1, 82.4; @@ -40,8 +104,9 @@ ifnot (feqs (p,p0) || feqs (s,s0)) failed ("f_test2 test 1 failed"); - p = f_test2 (x, y, &s; side=">"); - p0 = 0.53667; + % swap y, x + p = f_test2 (y, x, &s; side=">"); + p0 = 1-0.53667; ifnot (feqs (p,p0)) failed ("f_test2 size=> failed: expected %g, got %g", p0, p); @@ -49,6 +114,8 @@ p0 = 0.46333; ifnot (feqs (p,p0)) failed ("f_test2 side=< failed: expected %g, got %g", p0, p); + + check_usage (&f_test2); } private define map_cdf_to_pval (cdf) @@ -182,6 +249,8 @@ expected_p = 0.0389842391014099; expected_s = -0.376201540231705; run_kendall_test (x, y, expected_p, expected_s); + + check_usage (&kendall_tau); } private define test_ks () @@ -205,6 +274,9 @@ p = ks_test2 (x,y, &s); ifnot (feqs (p, expected_p)) failed ("*** ks_test2 pval=: %g, expected %g", p, expected_p); + + check_usage (&ks_test); + check_usage (&ks_test2); } private define test_mw_cdf (N) @@ -285,6 +357,8 @@ failed ("mw_test 5 returned %S, expected %S", w, ew); ifnot (feqs (p, ep)) failed ("mw_test 5 returned pval=%g, expected %g", p, ep); + + check_usage (&mw_test); } private define test_spearman () @@ -315,6 +389,8 @@ failed ("*** spearman_r statistic: %g, expected %g", s, expected_s); ifnot (feqs (p, expected_p)) failed ("*** spearman_r pval= %g, expected %g", p, expected_p); + + check_usage (&spearman_r); } private define check_pval_and_t (name, pv, t, pv_exp, t_exp) @@ -362,6 +438,54 @@ pval = ad_ktest (__push_list(datasets), &t; pval2=&pval2, stat2=&t2); check_pval_and_t ("ad_ktest3", pval, t, 0.193, 0.70807); check_pval_and_t ("ad_ktest3", pval2, t2, 0.190135, 0.72238); + + check_usage (&ad_ktest); +} + +private define test_ad_test () +{ + % Example from R (via statology.org) using iris data set. Check to + % see if the petal.width data are normally distributed + variable x, pval, t; + x = 0.2, 0.2, 0.2, 0.2, 0.2, 0.4, 0.3, 0.2, + 0.2, 0.1, 0.2, 0.2, 0.1, 0.1, 0.2, 0.4, 0.4, 0.3, 0.3, 0.3, 0.2, 0.4, 0.2, + 0.5, 0.2, 0.2, 0.4, 0.2, 0.2, 0.2, 0.2, 0.4, 0.1, 0.2, 0.2, 0.2, 0.2, 0.1, + 0.2, 0.2, 0.3, 0.3, 0.2, 0.6, 0.4, 0.3, 0.2, 0.2, 0.2, 0.2, 1.4, 1.5, 1.5, + 1.3, 1.5, 1.3, 1.6, 1, 1.3, 1.4, 1, 1.5, 1, 1.4, 1.3, 1.4, 1.5, 1, 1.5, 1.1, + 1.8, 1.3, 1.5, 1.2, 1.3, 1.4, 1.4, 1.7, 1.5, 1, 1.1, 1, 1.2, 1.6, 1.5, 1.6, + 1.5, 1.3, 1.3, 1.3, 1.2, 1.4, 1.2, 1, 1.3, 1.2, 1.3, 1.3, 1.1, 1.3, 2.5, + 1.9, 2.1, 1.8, 2.2, 2.1, 1.7, 1.8, 1.8, 2.5, 2, 1.9, 2.1, 2, 2.4, 2.3, 1.8, + 2.2, 2.3, 1.5, 2.3, 2, 2, 1.8, 2.1, 1.8, 1.8, 1.8, 2.1, 1.6, 1.9, 2, 2.2, + 1.5, 1.4, 2.3, 2.4, 1.8, 1.8, 2.1, 2.4, 2.3, 1.9, 2.3, 2.5, 2.3, 1.9, 2, + 2.3, 1.8; + variable t_exp = 5.1057, pval_exp = 1.125e-12; + pval = ad_test (x, &t); + ifnot (sigeq (t, t_exp, 5) && sigeq(pval, pval_exp, 4)) + { + failed ("ad_test: t=%S, texp=%S, p=%S, pexp=%S", + t, t_exp, pval, pval_exp); + } + + % Try with Marsaglia CDF + x = .0392,.0884,.260,.310,.454,.644,.797,.813,.921,.960; + t_exp = 0.36320; pval_exp = 0.11816; + pval = 1-ad_test (x, &t; cdf); + ifnot (sigeq (t, t_exp, 4) && sigeq(pval, pval_exp, 4)) + { + failed ("ad_test: t=%S, texp=%S, p=%S, pexp=%S", + t, t_exp, pval, pval_exp); + } + + x = .0015,.0078,.0676,.0961,.106,.107,.835,.861,.948,.992; + t_exp = 4.23161; pval_exp = 0.99293; + pval = 1-ad_test (x, &t; cdf); + ifnot (sigeq (t, t_exp, 4) && sigeq(pval, pval_exp, 4)) + { + failed ("ad_test: t=%S, texp=%S, p=%S, pexp=%S", + t, t_exp, pval, pval_exp); + } + + check_usage (&ad_test); } private variable XData = @@ -395,6 +519,8 @@ variable m1 = mean(xdata); ifnot (feqs (m0, m1, 1e-6, 1e-7)) failed ("test_mean_stddev: mean failed: got %S, expected %S", m0, m1); + if (any(m1 != sample_mean (xdata))) + failed ("test_mean_stddev: sample_mean failed"); variable n = length(xdata); if (0 == (n & 0x1)) @@ -422,9 +548,11 @@ { failed ("stddev(%S,0) produced incorrect values", a); } + if (any(sample_stddev (a,0) != x2)) + failed ("sample_stddev(%S,0) failed", a); } -private define wikipedia_sample_skewness (x) +private define wikipedia_skewness_g1 (x) { variable n = length(x)*1.0; variable xbar = sum(x)/n; @@ -432,25 +560,28 @@ return sqrt(n)*sum(dx*dx*dx)/sum(dx*dx)^1.5; } -private define wikipedia_sample_kurtosis (x) +private define wikipedia_kurtosis_g2 (x) { variable n = length(x)*1.0; variable xbar = sum(x)/n; variable dx = x-xbar; - return (n*sum(dx^4))/sum(dx*dx)^2 - 3; + return (n*sum(dx^4))/sum(dx*dx)^2 - 3.0; } define test_skewness_kurtosis () { - variable w = wikipedia_sample_skewness (XData); + variable w = wikipedia_skewness_g1 (XData); variable s = skewness (XData); ifnot (feqs (w,s,1e-6, 1e-7)) failed ("Expected skewness = %g, found %g", w, s); - w = wikipedia_sample_kurtosis (XData); + w = wikipedia_kurtosis_g2 (XData); s = kurtosis (XData); ifnot (feqs (w,s,1e-6, 1e-7)) failed ("Expected kurtosis = %g, found %g", w, s); + + check_usage (&skewness); + check_usage (&kurtosis); } private define test_binomial () @@ -494,6 +625,38 @@ p = t_test (x, 45, &t); ifnot ((feqs (p,p0)) || feqs (t,t0)) failed ("t_test 2 failed:\n p = %S, p0 = %S, t = %g, t0 = %g", p, p0, t, t0); + + check_usage (&t_test); + check_usage (&t_test2); +} + +private define test_welch_t_test () +{ + % These examples come from wikipedia + variable x1, x2, pval, t, t_exp, pval_exp; + + x1 = 27.5,21.0,19.0,23.6,17.0,17.9,16.9,20.1,21.9,22.6,23.1,19.6,19.0,21.7,21.4; + x2 = 27.1,22.0,20.8,23.4,23.4,23.5,25.8,22.0,24.8,20.2,21.9,22.1,22.9,20.5,24.4; + t_exp = -2.46; + pval_exp = 0.021; + pval = welch_t_test (x1, x2, &t); + ifnot (sigeq (t, t_exp, 3)) + failed ("welch_t_test 1: t=%S, t_exp=%S", t, t_exp); + ifnot (sigeq (pval, pval_exp, 2)) + failed ("welch_t_test 1; pval=%S, pval_exp=%S", pval, pval_exp); + + x1 = 17.2,20.9,22.6,18.1,21.7,21.4,23.5,24.2,14.7,21.8; + x2 = 21.5,22.8,21.0,23.0,21.6,23.6,22.5,20.7,23.4,21.8,20.7, + 21.7,21.5,22.5,23.6,21.5,22.5,23.5,21.5,21.8; + t_exp = -1.57; + pval_exp = 0.149; + pval = welch_t_test (x1, x2, &t); + ifnot (sigeq (t, t_exp, 3)) + failed ("welch_t_test 2: t=%S, t_exp=%S", t, t_exp); + ifnot (sigeq (pval, pval_exp, 3)) + failed ("welch_t_test 2; pval=%S, pval_exp=%S", pval, pval_exp); + + check_usage (&welch_t_test); } private define check_poisson_cdf (m, k, p) @@ -515,6 +678,42 @@ check_poisson_cdf (50000.0, 50000, 0.501189413); check_poisson_cdf (50000.0, 49900, 0.3283840695); check_poisson_cdf (50000.0, 50500, 0.9873021349); + + variable lambda = 0.1, k, s = 1.0, xk = 1.0, f = 1.0, norm = exp(-lambda); + variable n = 10; + variable ss = Double_Typen; + ss0 = 1.0; + _for k (1, n-1, 1) + { + xk = (xk*lambda); + f = f*k; + s += xk/f; + check_poisson_cdf (lambda, k, norm*s); + ssk = s; + } + k = 0:n-1; + ifnot (all(feqs(ss*norm, poisson_cdf(lambda, k)))) + { + failed ("poisson_cdf k-array"); + } + check_usage (&poisson_cdf); +} + +private define test_normal_cdf () +{ + variable m = 2.0, s = 1.0; + variable x = -3, -2, -1, 0, 1, 2, 3, 4; + % These numbers derived from onlinestatbook.com, which only + % prints results using ar most 4 digits of the CDF. + % + variable c = 0, 0, 0.0013, 0.0228, 0.1587, 0.5, 0.8413, 0.9772; + + variable cdf = normal_cdf (x, m, s); + ifnot (all (feqs (cdf, c, 1e-4, 1e-4))) + { + failed ("normal_cdf"); + } + check_usage (&normal_cdf); } private define test_mean_stddev_with_datatypes (xdata) @@ -530,10 +729,117 @@ } } +private define test_cumulant () +{ + variable x = 16.34, 10.76, 11.84, 13.55, 15.85, 18.20, 7.51, + 10.22, 12.52, 14.68, 16.08, 19.43,8.12, 11.20, + 12.95, 14.77, 16.83, 19.80, 8.55, 11.58, 12.10, + 15.02, 16.83, 16.98, 19.92, 9.47, 11.68, 13.41, + 15.35, 19.11; + variable n = length(x); + + variable k = cumulant (x, 4); + variable G1 = k2/k1^1.5; + variable s = sqrt(n*(n-1))/(n-2)*skewness (x); + ifnot (feqs (s, G1, 1e-12, 1e-12)) + failed ("cumulant k3"); + + variable G2 = k3/(k1*k1); + variable g2 = kurtosis (x); + s = (n-1.0)/(n-2)/(n-3)*((n+1)*g2 + 6); + ifnot (feqs (s, G2, 1e-12, 1e-12)) + failed ("cumulant k4"); + + check_usage (&cumulant); +} + +private define test_ztest () +{ + % From Langley (Practical Statistics Explained, pg 155, ex 2) + variable x = generate_data (73, 9, 40); + variable z, pval; + pval = z_test (x, 70.0, 5.0, &z); + variable z_exp = 3.0/5*sqrt(40); + variable p_exp = 0.0001478; + + ifnot (feqs (z, z_exp, 1e-6, 1e-8)) + { + failed ("z_test z"); + } + ifnot (feqs (pval, p_exp, 1e-6, 1e-6)) + { + failed ("z_test pval: %S vs %S", pval, p_exp); + } + check_usage (&z_test); +} + +private define test_pearson_r () +{ + variable x1, x2, t, pval; + + % This example comes from R using the mtcars dataset + x1 = 21, 21, 22.8, 21.4, 18.7, 18.1, 14.3, 24.4, 22.8, + 19.2, 17.8, 16.4, 17.3, 15.2, 10.4, 10.4, 14.7, 32.4, 30.4, 33.9, 21.5, + 15.5, 15.2, 13.3, 19.2, 27.3, 26, 30.4, 15.8, 19.7, 15, 21.4; + x2 = 2.62, 2.875, 2.32, 3.215, 3.44, 3.46, 3.57, 3.19, 3.15, 3.44, 3.44, 4.07, + 3.73, 3.78, 5.25, 5.424, 5.345, 2.2, 1.615, 1.835, 2.465, 3.52, 3.435, 3.84, + 3.845, 1.935, 2.14, 1.513, 3.17, 2.77, 3.57, 2.78; + variable t_exp = -9.559, pval_exp = 1.294e-10; + + pval = pearson_r (x1, x2, &t); + % The correlation function is equivalent to pearson_r + ifnot (feqs (t, correlation (x1, x2), 1e-9, 1e-12)) + failed ("correlation vs pearson_r"); + + % Note: t_exp in the R example is the t-test statistic, and not the + % pearson r value. So convert the r value to the t-test one. + variable n = length(x1); + t = t/sqrt(1-t*t)*sqrt(n-2); + + ifnot ((sigeq(t_exp, t, 4)) && sigeq (pval_exp, pval, 4)) + { + failed ("pearson_r: t=%S, texp=%S, p=%S, pexp=%S", + t, t_exp, pval, pval_exp); + } + + % pearson_r uses the covariance function + check_usage (&covariance); + check_usage (&pearson_r); + check_usage (&correlation); +} + +private define test_mann_kendall () +{ + % R example using Nile dataset + variable y = + 1120, 1160, 963, 1210, 1160, 1160, 813, 1230, 1370, 1140, + 995, 935, 1110, 994, 1020, 960, 1180, 799, 958, 1140, 1100, 1210, + 1150, 1250, 1260, 1220, 1030, 1100, 774, 840, 874, 694, 940, 833, 701, + 916, 692, 1020, 1050, 969, 831, 726, 456, 824, 702, 1120, 1100, 832, + 764, 821, 768, 845, 864, 862, 698, 845, 744, 796, 1040, 759, 781, 865, + 845, 944, 984, 897, 822, 1010, 771, 676, 649, 846, 812, 742, 801, + 1040, 860, 874, 848, 890, 744, 749, 838, 1050, 918, 986, 797, 923, + 975, 815, 1020, 906, 901, 1170, 912, 746, 919, 718, 714, 740, + pval, t; + + variable pval_exp = 3.658e-05, t_exp = -2.807413e-01; + pval = mann_kendall (y, &t); + ifnot ((sigeq(t_exp, t, 7)) && sigeq (pval_exp, pval, 4)) + { + failed ("mann_kendall: t=%S, texp=%S, p=%S, pexp=%S", + t, t_exp, pval, pval_exp); + } + check_usage (&mann_kendall); +} + define slsh_main () { testing_module ("stats"); + test_ad_test (); + test_normal_cdf(); + test_poisson_cdf (); + variable xdata = 256*urand(10); test_mean_stddev_with_datatypes (xdata); xdata = 256*urand(11); @@ -558,11 +864,17 @@ test_mw_cdf (10); test_mw_cdf (21); test_mw_test (); + test_ztest (); + test_welch_t_test (); test_ad_ktest (); test_spearman (); test_binomial (); test_student_t (); - test_poisson_cdf (); + test_mann_kendall (); + test_pearson_r (); + + test_skewness_kurtosis (); + test_cumulant (); end_test (); }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/test/test_zlib.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/test/test_zlib.sl
Changed
@@ -1,27 +1,25 @@ () = evalfile("./test.sl"); require ("zlib"); -private define silly_deflate (str) +private define silly_deflate (z, str) { - variable z = zlib_deflate_new (); variable x = ""; foreach (str) { variable ch = (); - x = x + _zlib_deflate (z.zobj, pack("C", ch), 0); + x = x + z.deflate (pack("C", ch); flush=ZLIB_NO_FLUSH); } x = x + z.flush (); return x; } -private define silly_inflate (zstr) +private define silly_inflate (z, zstr) { - variable z = zlib_inflate_new (); variable x = ""; foreach (zstr) { variable ch = (); - x = x + _zlib_inflate (z.zobj, pack("C", ch), 0); + x = x + z.inflate(pack("C", ch); flush=ZLIB_NO_FLUSH); } x = x + z.flush (); return x; @@ -36,24 +34,64 @@ failed ("to deflate/inflate %s", str0); return; } - variable zstr1 = silly_deflate (str0); + + variable z = zlib_deflate_new (); + variable zstr1 = silly_deflate (z, str0); + if (zstr1 != zstr) + { + failed ("to deflate %s via multiple calls", str0); + return; + } + % Repeat using the same object + z.reset (); + zstr1 = silly_deflate (z, str0); if (zstr1 != zstr) { failed ("to deflate %s via multiple calls", str0); return; } - str1 = silly_inflate (zstr1); + + z = zlib_inflate_new (); + str1 = silly_inflate (z, zstr1); if (str1 != str0) { failed ("to inflate %s via multiple calls", str0); return; } + % Repeat using the same object + z.reset (); + str1 = silly_inflate (z, zstr1); + if (str1 != str0) + { + failed ("to inflate %s via multiple calls", str0); + return; + } +} + +private define check_usage () +{ + foreach ("zlib_inflate()", "zlib_deflate()", + "zlib_inflate_new().inflate()", + "(@zlib_inflate_new().flush)()", + "zlib_deflate_new().deflate()", + "(@zlib_deflate_new().flush)()", + ) + { + variable f = (); + try + { + eval (f); + failed ("%s usage", f); + } + catch UsageError; + } } define slsh_main () { testing_module ("zlib"); + check_usage (); test_zlib (""); test_zlib ("\0"); test_zlib ("\0\0\0");
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/tm/base64funs.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/tm/base64funs.tm
Changed
@@ -123,7 +123,7 @@ variable b64 = _base64_encoder_new (&encode_callback, &s); _base64_encoder_accumulate (b64, bstr); _base64_encoder_close (b64); - return b; + return s; } #v- \example
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/tm/chksumfuns.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/tm/chksumfuns.tm
Changed
@@ -41,3 +41,190 @@ representation of the checksum. \seealso{sha1sum, md5sum_file, md5sum} \done + +\function{crc8sum} +\synopsis{Compute an 8 bit CRC on a string} +\usage{UChar_Type crc8sum (BString_Type bstr)} +\description + This function computes an 8 bit CRC for the specified string. A + number of variants that differ according to the polynomial, initial + value (seed), input/output bit reflection, and the XOR out value. + Supported variants include: +#v+ + cdma2000 ; poly=0x9B, seed=0xFF, refin=0, refout=0, xorout=0x00 + darc ; poly=0x39, seed=0x00, refin=1, refout=1, xorout=0x00 + dvb-s2 ; poly=0xD5, seed=0x00, refin=0, refout=0, xorout=0x00 + ebu ; poly=0x1D, seed=0xFF, refin=1, refout=1, xorout=0x00 + i-code ; poly=0x1D, seed=0xFD, refin=0, refout=0, xorout=0x00 + itu ; poly=0x07, seed=0x00, refin=0, refout=0, xorout=0x55 + maxim ; poly=0x31, seed=0x00, refin=1, refout=1, xorout=0x00 + rohc ; poly=0x07, seed=0xFF, refin=1, refout=1, xorout=0x00 + wcdma ; poly=0x9B, seed=0x00, refin=1, refout=1, xorout=0x00 +#v- + The CRC-8 algorithm is specified via qualifiers. The following + specify the same CRC-8 algorthm: +#v+ + crc8 = crc8sum ("string" ; type="maxim"); + crc8 = crc8sum ("string" ; poly=0x31, refin=1, refout=1); +#v- + The default CRC-8 algorithm is "dvb-s2". +\example + This example shows how to compute the Maxim CRC-8 value on a file. +#v+ + fp = fopen (file, "rb"); + c = chksum_new("crc8"; type="maxim"); + while (-1 != fread_bytes (&buf, 4096, fp) + c.accumulate (buf); + crc8 = chksum_close (); +#v- +\notes + This function is part of the \var{chksum} module: +#v+ + require("chksum"); +#v- +\seealso{crc16sum, crc32sum, crc8sum_file} +\done + +\function{crc8sum_file} +\synopsis{Compute the CRC-8 value for the contents of a file} +\usage{UChar_Type crc8sum_file (String_Type|File_Type f)} +\description + The \ifun{crc8sum_file} function computes the CRC-8 sum on the + contents of a file. The file may either be specified as a string + giving the name of the file, or as an open stdio \dtype{File_Type} + pointer. The function returns the 8-bit CRC value. + + Qualifiers are used to specifiy the CRC-8 variant. See the + documentation for \ivar{crc8sum} function for more information. +\seealso{crc8sum, crc32sum_file, sha1sum_file} +\done + + +\function{crc16sum} +\synopsis{Compute an 16 bit CRC on a string} +\usage{UInt16_Type crc16sum (BString_Type bstr)} +\description + This function computes an 16 bit CRC for the specified string. A + number of variants that differ according to the polynomial, initial + value (seed), input/output bit reflection, and the XOR out value. + Supported variants include: +#v+ + ccitt-0 ; poly=0x1021U, seed=0xFFFFU, refin=0, refout=0, xorout=0x0000U + arc ; poly=0x8005U, seed=0x0000U, refin=1, refout=1, xorout=0x0000U + aug-ccitt ; poly=0x1021U, seed=0x1D0FU, refin=0, refout=0, xorout=0x0000U + buypass ; poly=0x8005U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U + cdma2000 ; poly=0xC867U, seed=0xFFFFU, refin=0, refout=0, xorout=0x0000U + dds-110 ; poly=0x8005U, seed=0x800DU, refin=0, refout=0, xorout=0x0000U + dect-r ; poly=0x0589U, seed=0x0000U, refin=0, refout=0, xorout=0x0001U + dect-x ; poly=0x0589U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U + dnp ; poly=0x3D65U, seed=0x0000U, refin=1, refout=1, xorout=0xFFFFU + en-13757 ; poly=0x3D65U, seed=0x0000U, refin=0, refout=0, xorout=0xFFFFU + genibus ; poly=0x1021U, seed=0xFFFFU, refin=0, refout=0, xorout=0xFFFFU + maxim ; poly=0x8005U, seed=0x0000U, refin=1, refout=1, xorout=0xFFFFU + mcrf4xx ; poly=0x1021U, seed=0xFFFFU, refin=1, refout=1, xorout=0x0000U + riello ; poly=0x1021U, seed=0xB2AAU, refin=1, refout=1, xorout=0x0000U + t10-dif ; poly=0x8BB7U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U + teledisk ; poly=0xA097U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U + tms37157 ; poly=0x1021U, seed=0x89ECU, refin=1, refout=1, xorout=0x0000U + usb ; poly=0x8005U, seed=0xFFFFU, refin=1, refout=1, xorout=0xFFFFU + a ; poly=0x1021U, seed=0xC6C6U, refin=1, refout=1, xorout=0x0000U + kermit ; poly=0x1021U, seed=0x0000U, refin=1, refout=1, xorout=0x0000U + modbus ; poly=0x8005U, seed=0xFFFFU, refin=1, refout=1, xorout=0x0000U + x-25 ; poly=0x1021U, seed=0xFFFFU, refin=1, refout=1, xorout=0xFFFFU + xmodem ; poly=0x1021U, seed=0x0000U, refin=0, refout=0, xorout=0x0000U +#v- + The CRC-16 algorithm is specified via qualifiers. The following + specify the same CRC-16 algorthm: +#v+ + crc16 = crc16sum ("string" ; type="arc"); + crc16 = crc16sum ("string" ; poly=0x8005U, refin=1, refout=1); +#v- + The default CRC-16 algorithm is "ccitt-0". +\example + This example shows how to compute the Maxim CRC-16 value on a file. +#v+ + fp = fopen (file, "rb"); + c = chksum_new("crc16"; type="maxim"); + while (-1 != fread_bytes (&buf, 4096, fp) + c.accumulate (buf); + crc16 = chksum_close (); +#v- +\notes + This function is part of the \var{chksum} module: +#v+ + require("chksum"); +#v- +\seealso{crc8sum, crc32sum, crc16sum_file} +\done + +\function{crc16sum_file} +\synopsis{Compute the CRC-16 value for the contents of a file} +\usage{UInt16_Type crc16sum_file (String_Type|File_Type f)} +\description + The \ifun{crc16sum_file} function computes the CRC-16 sum on the + contents of a file. The file may either be specified as a string + giving the name of the file, or as an open stdio \dtype{File_Type} + pointer. The function returns the 16-bit CRC value. + + Qualifiers are used to specifiy the CRC-16 variant. See the + documentation for \ivar{crc16sum} function for more information. +\seealso{crc16sum, crc32sum_file, sha1sum_file} +\done + + +\function{crc32sum} +\synopsis{Compute an 32 bit CRC on a string} +\usage{UInt32_Type crc32sum (BString_Type bstr)} +\description + This function computes an 32 bit CRC for the specified string. A + number of variants that differ according to the polynomial, initial + value (seed), input/output bit reflection, and the XOR out value. + Supported variants include: +#v+ +(default); poly=0x04C11DB7U, seed=0xFFFFFFFFU, refin=1, refout=1, xorout=0xFFFFFFFFU + bzip2 ; poly=0x04C11DB7U, seed=0xFFFFFFFFU, refin=0, refout=0, xorout=0xFFFFFFFFU + c ; poly=0x1EDC6F41U, seed=0xFFFFFFFFU, refin=1, refout=1, xorout=0xFFFFFFFFU + d ; poly=0xA833982BU, seed=0xFFFFFFFFU, refin=1, refout=1, xorout=0xFFFFFFFFU + mpeg-2 ; poly=0x04C11DB7U, seed=0xFFFFFFFFU, refin=0, refout=0, xorout=0x00000000U + posix ; poly=0x04C11DB7U, seed=0x00000000U, refin=0, refout=0, xorout=0xFFFFFFFFU + q ; poly=0x814141ABU, seed=0x00000000U, refin=0, refout=0, xorout=0x00000000U + jamcrc ; poly=0x04C11DB7U, seed=0xFFFFFFFFU, refin=1, refout=1, xorout=0x00000000U + xfer ; poly=0x000000AFU, seed=0x00000000U, refin=0, refout=0, xorout=0x00000000U +#v- + The CRC-32 algorithm is specified via qualifiers. The following + specify the same CRC-32 algorthm: +#v+ + crc32 = crc32sum ("string" ; type="posix"); + crc32 = crc32sum ("string" ; poly=0x04C11DB7U, xorout=0xFFFFFFFFU); +#v- +\example + This example shows how to compute the default CRC-32 value on a file. +#v+ + fp = fopen (file, "rb"); + c = chksum_new("crc32"); + while (-1 != fread_bytes (&buf, 4096, fp) + c.accumulate (buf); + crc32 = chksum_close (); +#v- +\notes + This function is part of the \var{chksum} module: +#v+ + require("chksum"); +#v- +\seealso{crc8sum, crc32sum, crc32sum_file} +\done + +\function{crc32sum_file} +\synopsis{Compute the CRC-32 value for the contents of a file} +\usage{UInt32_Type crc32sum_file (String_Type|File_Type f)} +\description + The \ifun{crc32sum_file} function computes the CRC-32 sum on the + contents of a file. The file may either be specified as a string + giving the name of the file, or as an open stdio \dtype{File_Type} + pointer. The function returns the 32-bit CRC value. + + Qualifiers are used to specifiy the CRC-32 variant. See the + documentation for \ivar{crc32sum} function for more information. +\seealso{crc32sum, crc16sum_file, sha1sum_file} +\done +
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/tm/csvfuns.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/tm/csvfuns.tm
Changed
@@ -25,11 +25,13 @@ It is important to understand the difference between a ROW and a LINE in a CSV formatted file: a row may span more than one line in a file. The \exmp{skiplines} qualifier specifies the number of LINES to be - skipped, not ROWS. + skipped, not ROWS. However, if a comment string appears at the + beginning of one of the lines forming a multiline string, it will + treated as part of the string and not as a comment. CSV files have no notion of data-types: all field values are strings. For this reason, the \exmp{type} qualifier introduces an extra layer - that is not part CSV format. + that is not part of the CSV specification. \seealso{csv.readcol, csv.readrow} \done
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/tm/randfuns.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/tm/randfuns.tm
Changed
@@ -174,7 +174,7 @@ \done \function{rand} -\synopsis{Generate random integers numbers} +\synopsis{Generate random unsigned integers} \usage{X = rand (Rand_Type g, ,num)} \description This function generates unsigned 32 bit randomly distributed
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/tm/statsfuns.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/tm/statsfuns.tm
Changed
@@ -39,8 +39,8 @@ present, then it must be a reference to a variable that will be set to the value of the statistic upon return. \qualifiers -\qualifier{mu=value}{Specifies the known mean of the normal distribution}. -\qualifier{sigma}{Specifies the known standard deviation of the normal distribution} +\qualifier{mean=value}{Specifies the known mean of the normal distribution}. +\qualifier{stddev=value}{Specifies the known standard deviation of the normal distribution} \qualifier{cdf}{If present, the data will be interpreted as a CDFs of a known, but unspecified, distribution.} \notes For testing the hypothesis that a dataset is sampled from a known, @@ -53,7 +53,22 @@ Marsaglia and Marsaglia: Evaluating the Anderson-Darling Distribution, Journal of Statistical Software, Vol. 9, Issue 2, Feb 2004. -\seealso{ad_ktest, ks_test, t_test, z_test, normal_cdf, } +\seealso{ad_ktest, ks_test, t_test, z_test, normal_cdf} +\done + + +\function{cumulant} +\synopsis{Compute the first n cumulants of an array} +\usage{k1,...,kn = cumulant (X, n)} +\description + This function returns unbiased estimates of the first \exmp{n} + cumulants from an array \exmp{X} of samples of a probability + distribution. The cumulants are returned as an array of size + \exmp{n}. +\notes + The implementation currently restricts the value of n to 1, 2, 3, or 4. + The estimator of the nth cumulent is also known as the nth k-statistic. +\seealso{mean, stddev, kurtosis, skewness} \done \function{median} @@ -136,7 +151,7 @@ \synopsis{Compute the skewness of an array of values} \usage{s = skewness (a)} \description - This function computes the so-called skewness of the array \exmp{a}. + This function computes the skewness (g1) of the array \exmp{a}. \seealso{mean, stddev, kurtosis} \done @@ -144,7 +159,7 @@ \synopsis{Compute the kurtosis of an array of values} \usage{s = kurtosis (a)} \description - This function computes the so-called kurtosis of the array \exmp{a}. + This function computes the kurtosis (g2) of the array \exmp{a}. \notes This function is defined such that the kurtosis of the normal distribution is 0, and is also known as the ``excess-kurtosis''. @@ -181,11 +196,11 @@ \function{poisson_cdf} \synopsis{Compute the Poisson CDF} -\usage{cdf = poisson_cdf (Double_Type m, Int_Type k)} +\usage{cdf = poisson_cdf (Double_Type lambda, Int_Type k)} \description This function computes the CDF for the Poisson probability - distribution parameterized by the value \exmp{m}. For values of - \exmp{m>100} and \exmp{abs(m-k)<sqrt(m)}, the Wilson and Hilferty + distribution parameterized by the value \exmp{lambda}. For values of + \exmp{lambda>100} and \exmp{abs(lambda-k)<sqrt(lambda)}, the Wilson and Hilferty asymptotic approximation is used. \seealso{chisqr_cdf} \done
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/varray-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/varray-module.c
Changed
@@ -1,5 +1,5 @@ /* -*- mode: C; mode: fold -*- -Copyright (C) 2010-2017,2018 John E. Davis +Copyright (C) 2010-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/zlib-module.c -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/zlib-module.c
Changed
@@ -1,6 +1,6 @@ /* -*- mode: C; mode: fold; -*- */ /* -Copyright (C) 2008-2017,2018 John E. Davis +Copyright (C) 2008-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -485,7 +485,7 @@ return; if (z->initialized) - check_zerror (deflateReset (&z->zs)); + check_zerror (inflateReset (&z->zs)); } static void inflate_flush_intrin (ZLib_Type *z, int *flush)
View file
_service:tar_scm:slang-2.3.2.tar.bz2/modules/zlib.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/modules/zlib.sl
Changed
@@ -1,5 +1,5 @@ % -*- mode: slang; mode: fold -*- -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slang.lis -> _service:tar_scm:slang-2.3.3.tar.bz2/slang.lis
Changed
@@ -132,7 +132,9 @@ @modules/base64.sl @modules/chksum-module.c @modules/chksum_sha1.c +@modules/chksum_sha2.c @modules/chksum_md5.c +@modules/chksum_crc.c @modules/chksum.h @modules/chksum.sl @modules/csv-module.c @@ -185,6 +187,7 @@ @modules/test/test.sl @modules/test/test_base64.sl @modules/test/test_chksum.sl +@modules/test/test_crc.sl @modules/test/test_csv.sl @modules/test/test_fcntl.sl @modules/test/test_fork.sl @@ -299,6 +302,7 @@ @slsh/lib/profile.sl @slsh/lib/print.sl @slsh/lib/slshhelp.sl +@slsh/lib/timestamp.sl @slsh/lib/cmdopt.sl @slsh/lib/readascii.sl @slsh/lib/process.sl @@ -326,6 +330,7 @@ @slsh/lib/help/process.hlp @slsh/lib/help/setfuns.hlp @slsh/lib/help/listfuns.hlp +@slsh/lib/help/timestamp.hlp @slsh/lib/tm/Makefile @slsh/lib/tm/arrayfuns.tm @@ -340,6 +345,7 @@ @slsh/lib/tm/process.tm @slsh/lib/tm/setfuns.tm @slsh/lib/tm/listfuns.tm +@slsh/lib/tm/timestamp.tm @slsh/lib/test/runtests.sh 0755 @slsh/lib/test/common.sl @@ -350,6 +356,7 @@ @slsh/lib/test/test_process.sl @slsh/lib/test/test_setfuns.sl @slsh/lib/test/test_listfuns.sl +@slsh/lib/test/test_timestamp.sl @slsh/doc/tm/slsh.tm @slsh/doc/tm/Makefile @@ -379,6 +386,7 @@ @slsh/scripts/jpegsize 0755 @slsh/scripts/svnsh 0755 @slsh/scripts/sldb 0755 +@slsh/scripts/slcov 0755 @slsh/scripts/slprof 0755 @slsh/scripts/slstkchk 0755 @slsh/slsh.c
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/Makefile.in -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/Makefile.in
Changed
@@ -37,7 +37,7 @@ SLSH_DOC_DIR = $(datarootdir)/doc/slsh SLSH_LOCALLIB_DIR = $(SLSH_LIB_DIR)/local-packages SLSH_SCRIPT_DIR = $(SLSH_LIB_DIR)/scripts -SCRIPTS = jpegsize lsrpm sldb svnsh slprof slstkchk +SCRIPTS = jpegsize lsrpm sldb svnsh slprof slstkchk slcov #--------------------------------------------------------------------------- # Hard-coded paths may be configured during run-time via the SLSH_CONF_DIR # and SLSH_PATH env variables. The names of those variables may be @@ -77,22 +77,22 @@ #---------------------------------------------------------------------------- @SET_MAKE@ SHELL = /bin/sh -INST_LIBS = $(DEST_LIB_DIR) $(RPATH) $(SLANG_INST_LIB) -lslang $(READLINE_LIB) $(DYNAMIC_LIBS) +INST_LIBS = $(DEST_LIB_DIR) $(RPATH) $(SLANG_INST_LIB) -lslang $(LDFLAGS) $(READLINE_LIB) $(DYNAMIC_LIBS) DEFS = -DSLSH_CONF_DIR='"$(SLSH_CONF_DIR)"' -DSLSH_PATH='"$(SLSH_LIB_DIR)"' \ -DSLSH_CONF_DIR_ENV='$(SLSH_CONF_DIR_ENV)' -DSLSH_LIB_DIR_ENV='$(SLSH_LIB_DIR_ENV)' \ -DSLSH_PATH_ENV='$(SLSH_PATH_ENV)' $(SLSYSWRAP_DEF) SDEFS = $(DEFS) -DSLSH_STATIC -SRC_LIBS = $(SLANG_ELFLIB) -lslang $(SLSYSWRAP_LIB) $(READLINE_LIB) $(DYNAMIC_LIBS) -STATIC_SRC_LIBS = $(SLANG_OBJLIB) -lslang $(SLSYSWRAP_LIB) $(READLINE_LIB) $(STATIC_LIBS) +SRC_LIBS = $(SLANG_ELFLIB) -lslang $(SLSYSWRAP_LIB) $(LDFLAGS) $(READLINE_LIB) $(DYNAMIC_LIBS) +STATIC_SRC_LIBS = $(SLANG_OBJLIB) -lslang $(SLSYSWRAP_LIB) $(LDFLAGS) $(READLINE_LIB) $(STATIC_LIBS) OBJDIR_TSTAMP = $(OBJDIR)/tstamp SOBJDIR_TSTAMP = $(SOBJDIR)/tstamp # all: $(OBJDIR)/slsh_exe slsh: $(OBJDIR)/slsh $(OBJDIR)/slsh_exe: $(OBJDIR)/slsh.o $(OBJDIR)/readline.o - $(CC) $(CFLAGS) $(OBJDIR)/slsh.o $(OBJDIR)/readline.o -o $(OBJDIR)/slsh_exe $(LDFLAGS) $(DLINK_FLAGS) $(SRC_LIBS) + $(CC) $(OBJDIR)/slsh.o $(OBJDIR)/readline.o -o $(OBJDIR)/slsh_exe $(LDFLAGS) $(DLINK_FLAGS) $(SRC_LIBS) $(OBJDIR)/slsh: $(OBJDIR)/slsh.o $(OBJDIR)/readline.o - $(CC) $(CFLAGS) $(OBJDIR)/slsh.o $(OBJDIR)/readline.o -o $(OBJDIR)/slsh $(LDFLAGS) $(DLINK_FLAGS) $(INST_LIBS) + $(CC) $(OBJDIR)/slsh.o $(OBJDIR)/readline.o -o $(OBJDIR)/slsh $(LDFLAGS) $(DLINK_FLAGS) $(INST_LIBS) $(OBJDIR)/slsh.o: $(OBJDIR_TSTAMP) slsh.c slsh.h config.h Makefile cd $(OBJDIR) && $(CC) $(SLANG_SRCINC) $(CFLAGS) -c $(DEFS) $(SRCDIR)/slsh.c $(OBJDIR)/readline.o: $(OBJDIR_TSTAMP) readline.c slsh.h config.h Makefile @@ -103,7 +103,7 @@ # static: $(SOBJDIR)/slsh $(SOBJDIR)/slsh: $(SOBJDIR)/slsh.o $(SOBJDIR)/readline.o - $(CC) $(CFLAGS) $(SOBJDIR)/slsh.o $(SOBJDIR)/readline.o -o $(SOBJDIR)/slsh $(LDFLAGS) $(STATIC_SRC_LIBS) + $(CC) $(SOBJDIR)/slsh.o $(SOBJDIR)/readline.o -o $(SOBJDIR)/slsh $(LDFLAGS) $(STATIC_SRC_LIBS) $(SOBJDIR)/slsh.o: $(SOBJDIR_TSTAMP) slsh.c slsh.h config.h Makefile cd $(SOBJDIR) && $(CC) $(SLANG_SRCINC) $(CFLAGS) -c $(SDEFS) $(SRCDIR)/slsh.c $(SOBJDIR)/readline.o: $(SOBJDIR_TSTAMP) readline.c slsh.h config.h Makefile @@ -124,7 +124,7 @@ $(MKINSDIR) $(DEST_SLSH_LOCALLIB_DIR) $(MKINSDIR) $(DEST_SLSH_SCRIPT_DIR) $(MKINSDIR) $(DEST_SLSH_DOC_DIR)/html -install_lib_files: +install_lib_files: install_directories @for X in lib/*.sl; \ do \ echo $(INSTALL_DATA) $$X $(DEST_SLSH_LIB_DIR); \ @@ -133,7 +133,7 @@ exit 1; \ fi; \ done -install_rline_files: +install_rline_files: install_directories @for X in lib/rline/*.sl lib/rline/slrline.rc; \ do \ echo $(INSTALL_DATA) $$X $(DEST_SLSH_LIB_DIR)/rline/; \ @@ -142,7 +142,7 @@ exit 1; \ fi; \ done -install_scripts: +install_scripts: install_directories @for X in $(SCRIPTS); \ do \ echo $(INSTALL) scripts/$$X $(DEST_SLSH_SCRIPT_DIR); \ @@ -151,7 +151,7 @@ exit 1; \ fi; \ done -install_help: +install_help: install_directories @for X in lib/help/*.hlp; \ do \ echo $(INSTALL_DATA) $$X $(DEST_SLSH_HELP_DIR); \ @@ -160,7 +160,7 @@ exit 1; \ fi; \ done -install_docs: +install_docs: install_directories @for X in doc/html/*.html; \ do \ echo $(INSTALL_DATA) $$X $(DEST_SLSH_DOC_DIR)/html/; \ @@ -171,11 +171,11 @@ done $(INSTALL_DATA) doc/man/slsh.1 $(DEST_MAN_DIR)/ # -install_slsh: +install_slsh: install_directories $(OBJDIR)/slsh $(INSTALL) $(OBJDIR)/slsh $(DEST_BIN_DIR)/ -install_static_slsh: +install_static_slsh: install_directories $(SOBJDIR)/slsh $(INSTALL) $(SOBJDIR)/slsh $(DEST_BIN_DIR)/ -install_slshrc: +install_slshrc: install_directories $(INSTALL_DATA) etc/slsh.rc $(DEST_SLSH_CONF_DIR)/ echo 'prepend_to_slang_load_path("$(SLSH_LOCALLIB_DIR)");' >> $(DEST_SLSH_CONF_DIR)/slsh.rc install_common: install_directories install_lib_files install_rline_files install_scripts install_help install_docs @@ -199,4 +199,3 @@ install_lib_files install_rline_files install_scripts install_help \ install_docs install-static static install_common \ install_slsh install_static_slsh install_slshrc -
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun-1.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun-1.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0): Introduction</TITLE> <LINK HREF="slshfun-2.html" REL=next>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun-10.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun-10.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0): Profiling Functions</TITLE> <LINK HREF="slshfun-11.html" REL=next> <LINK HREF="slshfun-9.html" REL=previous>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun-11.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun-11.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0): Set Functions</TITLE> <LINK HREF="slshfun-12.html" REL=next> <LINK HREF="slshfun-10.html" REL=previous>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun-12.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun-12.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0): Miscellaneous Functions</TITLE> <LINK HREF="slshfun-13.html" REL=next> <LINK HREF="slshfun-11.html" REL=previous>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun-13.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun-13.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0): SLSH intrinsic functions</TITLE> <LINK HREF="slshfun-12.html" REL=previous> <LINK HREF="slshfun.html#toc13" REL=contents>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun-2.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun-2.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0): The require Function</TITLE> <LINK HREF="slshfun-3.html" REL=next> <LINK HREF="slshfun-1.html" REL=previous>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun-3.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun-3.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0): Command Line Parsing Functions</TITLE> <LINK HREF="slshfun-4.html" REL=next> <LINK HREF="slshfun-2.html" REL=previous>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun-4.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun-4.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0): Filename Globbing and Related Functions</TITLE> <LINK HREF="slshfun-5.html" REL=next> <LINK HREF="slshfun-3.html" REL=previous>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun-5.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun-5.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0): Reading Text-formated Data Files</TITLE> <LINK HREF="slshfun-6.html" REL=next> <LINK HREF="slshfun-4.html" REL=previous>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun-6.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun-6.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0): Structure Functions</TITLE> <LINK HREF="slshfun-7.html" REL=next> <LINK HREF="slshfun-5.html" REL=previous>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun-7.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun-7.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0): Array Functions</TITLE> <LINK HREF="slshfun-8.html" REL=next> <LINK HREF="slshfun-6.html" REL=previous>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun-8.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun-8.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0): List Functions and List-based Data Structures</TITLE> <LINK HREF="slshfun-9.html" REL=next> <LINK HREF="slshfun-7.html" REL=previous>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun-9.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun-9.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0): Subprocess Functions</TITLE> <LINK HREF="slshfun-10.html" REL=next> <LINK HREF="slshfun-8.html" REL=previous>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/html/slshfun.html -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/html/slshfun.html
Changed
@@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> <HTML> <HEAD> - <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.69"> + <META NAME="GENERATOR" CONTENT="LinuxDoc-Tools 0.9.73"> <TITLE> SLSH Library Reference (version 2.3.0)</TITLE> <LINK HREF="slshfun-1.html" REL=next>
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/man/slsh.1 -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/man/slsh.1
Changed
@@ -3,7 +3,7 @@ .\" <http://shell.ipoline.com/~elmert/comp/docbook2X/> .\" Please send any bug reports, improvements, comments, patches, .\" etc. to Steve Cheng <steve@ggi-project.org>. -.TH "SLSH" "1" "04 March 2018" "" "" +.TH "SLSH" "1" "19 February 2021" "" "" .SH NAME slsh \- Interpreter for S-Lang scripts
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/doc/tm/local.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/doc/tm/local.tm
Changed
@@ -1,4 +1,5 @@ #d slang \bf{S-Lang} +#d most \bf{most} #d slang2 \bf{S-Lang 2} #d slrn \bf{slrn} #d sldb \bf{sldb}
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/arrayfuns.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/arrayfuns.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/cmdopt.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/cmdopt.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for @@ -170,6 +170,8 @@ { if (value != NULL) value = (@opt.convert_method) (opts, opt, name, value); + else + value = opt.default_value; (@opt.valuep)(value, __push_args(opt.callback_args)); return; @@ -233,25 +235,6 @@ return find_opt (opts, name); } -private define process_short_args (opts, letters) -{ - variable i = 0, n = strlen (letters); - while (i < n) - { - i++; - variable name = substr (letters, i, 1); - variable opt = find_short_opt (opts, name); - variable value = NULL; - if (opt.flags & CMDOPT_REQ_VALUE) - { - if (i < n) - value = substr (letters, i+1, n); - i = n; - } - process_option (opts, opt, name, NULL); - } -} - private define parse_arg (arg) { variable pos = is_substr (arg, "="); @@ -330,7 +313,7 @@ { i++; if (i == iend) - usage_error (opts, opt, "value expected"); + usage_error (opts, arg, "value expected"); value = argvi; }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/fswalk.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/fswalk.sl
Changed
@@ -1,31 +1,49 @@ % Functions to walk the file system -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for % more information. +private define get_stat (w, file) +{ + variable st = (@w.stat_func)(file); + if (st == NULL) + () = fprintf (stderr, "Unable to stat %s: %s\n", file, errno_string (errno)); + return st; +} + private define process_dir (w, dir, dir_st); private define process_dir (w, dir, dir_st) { - variable status; - if (w.dir_method != NULL) + variable status = 1; + + EXIT_BLOCK + { + if ((status != -1) && (w.leavedir_method != NULL)) + { + if (-1 == (@w.leavedir_method)(dir, dir_st, __push_list (w.leavedir_method_args))) + return -1; + } + return status; + } + + if (w.enterdir_method != NULL) { - status = (@w.dir_method) (dir, dir_st, __push_list (w.dir_method_args)); + status = (@w.enterdir_method) (dir, dir_st, __push_list (w.enterdir_method_args)); if (status <= 0) - return status; + return; } foreach (listdir (dir)) { variable file = (); file = path_concat (dir, file); - variable st = (@w.stat_func)(file); + + variable st = get_stat (w, file); if (st == NULL) - { - () = fprintf (stderr, "Unable to stat %s: %s\n", file, errno_string (errno)); - continue; - } + continue; + if (stat_is ("dir", st.st_mode)) { status = process_dir (w, file, dir_st); @@ -39,43 +57,50 @@ continue; status = (@w.file_method) (file, st, __push_list(w.file_method_args)); if (status <= 0) - return status; + return; } - return 1; + status = 1; } private define fswalk (w, start) { - variable st = (@w.stat_func)(start); - ifnot (stat_is ("dir", st.st_mode)) - { - throw InvalidParmError, "fs_walk: $start is not a directory"$; - } - () = process_dir (w, start, st); + variable st = get_stat (w, start); + if (st == NULL) return; + + if (stat_is ("dir", st.st_mode)) + () = process_dir (w, start, st); + else if (w.file_method_args != NULL) + () = (@w.file_method) (start, st, __push_list(w.file_method_args)); } define fswalk_new () { - if (_NARGS != 2) - usage ("\ -w = fswalk_new (dirfunc, filefunc ; qualifiers);\n\ + ifnot (2 <= _NARGS <= 3) + usage ("\n\ +w = fswalk_new (enterdir_func, file_func , leavedir_func ; qualifiers);\n\ w.walk (topdir);\n\ \n\ Qualifiers:\n\ - dargs={args,...} Additional arguments to be passed to dirfunc\n\ - fargs={args,...} Additional arguments to be passed to dirfunc\n\ - followlinks=0|1 Indicates whethe or not symbolic links will be followed\n\ + dargs={args,...} Additional arguments to be passed to enterdir_func\n\ + fargs={args,...} Additional arguments to be passed to file_func\n\ + largs={args,...} Additional arguments to be passed to leavedir_func\n\ + followlinks=0|1 Indicates whether or not symbolic links will be followed\n\ "); - variable dir_method, file_method; - (dir_method, file_method) = (); + variable enterdir_method, leavedir_method = NULL, file_method; + if (_NARGS == 3) leavedir_method = (); + (enterdir_method, file_method) = (); - variable dir_method_args = qualifier ("dargs", {}); + variable enterdir_method_args = qualifier ("dargs", {}); variable file_method_args = qualifier ("fargs", {}); - if (typeof (dir_method_args) != List_Type) - dir_method_args = {dir_method_args}; + variable leavedir_method_args = qualifier ("largs", {}); + + if (typeof (enterdir_method_args) != List_Type) + enterdir_method_args = {enterdir_method_args}; if (typeof (file_method_args) != List_Type) file_method_args = {file_method_args}; + if (typeof (leavedir_method_args) != List_Type) + leavedir_method_args = {leavedir_method_args}; variable followlinks = (qualifier_exists ("followlinks") && (0 != qualifier ("followlinks"))); @@ -84,8 +109,10 @@ walk = &fswalk, file_method = file_method, file_method_args = file_method_args, - dir_method = dir_method, - dir_method_args = dir_method_args, + enterdir_method = enterdir_method, + enterdir_method_args = enterdir_method_args, + leavedir_method = leavedir_method, + leavedir_method_args = leavedir_method_args, stat_func = (followlinks ? &stat_file : &lstat_file), }; return w;
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/glob.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/glob.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/help/fswalk.hlp -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/help/fswalk.hlp
Changed
@@ -4,36 +4,45 @@ Create an object to walk the filesystem tree USAGE - obj = fswalk_new (Ref_Type dirfunc, Ref_Type filefunc; qualifiers) + obj = fswalk_new (Ref_Type enterdir_func, Ref_Type file_func, Ref_Type leavedir_func; qualifiers) DESCRIPTION The `fswalk_new' function creates an object that is useful - for exploring a filesystem tree. It requires two arguments that + for exploring a filesystem tree. It requires at least two arguments that are references to functions to be called when a directory or file is - encountered. Each of these functions is passed at least two + encountered. The third argument (`leavedir_func') is optional. + Each of these functions is passed at least two arguments: the name of the file or directory (including leading path elements relative to the directory where processing started), and - the stat structure of the of the file or directory. Qualifiers may + the stat structure of the file or directory. Qualifiers may be used to specify additional arguments. The object's `walk' method is the one that actually walks the filesystem. - The directory callback function must return an integer value that + The `enterdir_func' callback function is called when a + directory is encountered. It must return an integer value that indicates how it should be processed. If the function returns 0, then the directory will be skipped (pruned). A positive value indicates that the directory will processed. If the function returns a negative value, then no further processing by the walk - function will take place and control will pass to the user. + function will take place and control will pass back to the caller. The + value of this function may be NULL. - The file callback function must also return an integer that + The `file_func' callback function must return an integer that indicates how processing should continue. If it returns a positive value, then additional files in the corresponding directory will be processed. If it returns 0, then no further files or subdirectories of the directory will be processed, and processing will continue to take place in the parent directory. Otherwise, the return value is negative, which indicates that processing should be stopped and - control will pass back to the caller. + control will pass back to the caller. The value of this function + may be NULL. + + If the `leavedir_func' has been specified and is non-NULL, then + it will be called after the directory has been processed. It must + return an integer. A return value of -1 is used to indicate that an + error has occurred, and that further processing should stop. QUALIFIERS The following qualifiers are supported: @@ -41,12 +50,17 @@ dargs={args...} `dargs' is a list of additional arguments that will be added when - calling the directory callback function. + calling the `enterdir_func' callback. fargs={args...} `fargs' is a list of additional arguments that will be added when - calling the file callback function. + calling the `file_func' callback function. + + largs={args...} + + `largs' is a list of additional arguments that will be added when + calling the `leavedir_func' callback. followlinks=val
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/help/process.hlp -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/help/process.hlp
Changed
@@ -105,6 +105,35 @@ If this qualifier exists, its value will be passed as the second argument to the `pre_exec_hook' callback function. + exec_hook=&func + + This qualifier may be used to specify the function that actually + executes the child process. It is expected to take 2 arguments: + the `argv' array and the value of the `exec_hook_arg' + qualifier. The function should invoke the `execvp' system + and return its value. Only in very special cases, such as testing + the process code itself, should this hook be needed. + + exec_hook_arg=VAL + + The value of this qualifier will be passed to the `exec_hook' + callback function. + + exit_hook=&func + + This qualifier may be used to specify the function to be called + just before the child process exits in the case of a failure. + executes the child process. The function will be passed 2 + arguments: the `argv' array and the value of the + `exit_hook_arg' qualifier. The function should not return a + value. Only in very special cases, such as testing the process + code itself, should this hook be needed. + + exit_hook_arg=VAL + + The value of this qualifier will be passed to the `exit_hook' + callback function. + Note that the read and write qualifiers specify the nature of the file descriptors from the child process's view. That is, those opened in the child process using the read qualifier, may be written
View file
_service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/help/timestamp.hlp
Added
@@ -0,0 +1,33 @@ +timestamp_parse + + SYNOPSIS + Parse a timestamps to Unix time + + USAGE + Long_Type timestamp_parse (String_Type timestamp) + + DESCRIPTION + The `timestamp_parse' function parses the string representation + of a timestamp and returns it expessed as the number of seconds + since the Unix Epoch. + + The `timestamp' string is assumed to conform to one of the + following standards: RFCs 822, 1036, 1123, 2822, 3339, and ISO-8601. + Examples include: + + "2020-05-02T17:09:58+00:00" + "Sunday, 02-May-20 17:09:58 UTC" + "Sun, 2 May 2020 17:09:58 +0000" + "5/2/2020, 5:31:57 PM EDT" + "2020-02-14T170958+0000" + "5/02/2020, 5:31:57 PM", + + If a timezone specifier is missing, the local timezone will be + assumed. + + Upon success, the functions returns the number of seconds since + 1970-01-01T00:00:00 UTC. If the format of the timestamp is not + recognized as the function, NULL will be returned. + + SEE ALSO + _time, ctime, strftime, gmtime, timegm, mktime
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/listfuns.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/listfuns.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/print.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/print.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for @@ -75,10 +75,10 @@ # ifexists SIGPIPE signal (SIGPIPE, SIG_IGN, &Sigpipe_Handler); # endif - variable fp = popen (cmd, "w"); - try { + variable fp = popen (cmd, "w"); + if (fp == NULL) throw OpenError, "Unable to open the pager ($cmd)"$; @@ -340,16 +340,16 @@ { case Array_Type: variable dims = array_shape (x); - use_pager = ((dims0 > pager_rows) - || (prod(dims) > 10*pager_rows)); + use_pager = ((dims0 >= pager_rows) + || (prod(dims) >= 10*pager_rows)); } { case List_Type: - use_pager = length (x) > pager_rows; + use_pager = length (x) >= pager_rows; } { case String_Type: - use_pager = count_byte_occurrences (x, '\n') > pager_rows; + use_pager = count_byte_occurrences (x, '\n') >= pager_rows; if (noescape) str_x = x; } @@ -359,7 +359,7 @@ else str_x = generic_to_string (x); - use_pager = (count_byte_occurrences (str_x, '\n') > pager_rows); + use_pager = (count_byte_occurrences (str_x, '\n') >= pager_rows); } }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/process.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/process.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for @@ -56,6 +56,9 @@ { variable name = (); variable fd, ifd, value, defflags = 0, flags, file; + + value = get_struct_field (q, name); + if (1 != sscanf (name, "fd%d", &ifd)) { if (name == "stdin") ifd = 0; @@ -66,7 +69,6 @@ if (ifd == 0) defflags = O_RDONLY|O_NOCTTY; if ((ifd == 1) || (ifd == 2)) defflags = O_WRONLY|O_TRUNC|O_CREAT|O_NOCTTY; - value = get_struct_field (q, name); if (typeof(value) == String_Type) { (flags, file) = parse_redir (value); @@ -106,7 +108,7 @@ return (redir_fds, redir_ifds); } -% parse dipN=M qualifiers +% parse dupN=M qualifiers private define parse_dup_qualifiers (q) { variable open_fds = FD_Type0, wanted_ifds = Int_Type0; @@ -146,23 +148,44 @@ private define dup2_open_fds (wanted_ifds, open_ifds, open_fds, idx_offset) { variable i, ifd, fd; + _for i (0, length(wanted_ifds)-1, 1) { ifd = wanted_ifdsi; i += idx_offset; variable j = wherefirst (open_ifds == ifd); + + if (j == i) continue; + if (j == 0) + { + % This is the file descriptior that we want to use for + % messages + % Dup it to something else. + fd = dup_fd (open_fds0); + if (fd == NULL) + throw OSError, "dup_fd failed: " + errno_string (); + () = fcntl_setfd (fd, fcntl_getfd (fd) | FD_CLOEXEC); + + open_fds0 = fd; + open_ifds0 = _fileno(fd); + j = wherefirst (open_ifds == ifd); + } + if (j != NULL) { - if (j == i) - continue; + % Here, ifd is already associated with an open + % descriptor. Dup that descriptor to something else so + % that ifd can be used. fd = dup_fd (open_fdsj); if (fd == NULL) throw OSError, "dup_fd failed: " + errno_string (); open_ifdsj = _fileno(fd); open_fdsj = fd; + % drop } + % Replace open_ifdsi with the desired descriptor if (-1 == dup2_fd (open_fdsi, ifd)) throw OSError, "dup2_fd failed: " + errno_string (); @@ -178,7 +201,7 @@ % The child pipe ends will need to be dup2'd to the corresponding % integers. Care must be exercised to not stomp on pipe descriptors % that have the same values. - % Note: The first on in the list is the traceback fd + % Note: The first one in the list is the traceback fd variable child_open_ifds = array_map (Int_Type, &_fileno, child_fds); dup2_open_fds (required_child_ifds, child_open_ifds, child_fds, 1); @@ -192,6 +215,7 @@ child_fds = child_fds, redir_fds; child_open_ifds = child_open_ifds, array_map (Int_Type, &_fileno, redir_fds); + redir_fds = NULL; % decrement ref-counts dup2_open_fds (wanted_redir_ifds, child_open_ifds, child_fds, ofs); @@ -209,6 +233,7 @@ % descriptors that correspond to the ifdNs child_fds = child_fds, fdMs, fdMs; child_open_ifds = child_open_ifds, ifdMs, Int_Typenum_aliased-1; + dup2_open_fds (ifdNs, child_open_ifds, child_fds, length(child_fds)-num_aliased); } } @@ -229,7 +254,7 @@ child_open_ifds = list_to_array (list); } - variable close_mask = Char_TypeOPEN_MAX+1; + variable close_mask = Char_TypeOPEN_MAX; close_mask 3: = 1; foreach ifd (child_open_ifds) close_maskifd = 0; _for ifd (0, length(close_mask)-1, 1) @@ -237,7 +262,12 @@ if (close_maskifd) () = _close (ifd); } - () = execvp (argv0, argv); + variable exec_hook = qualifier("exec_hook"); + if (exec_hook == NULL) + () = execvp (argv0, argv); + else + () = (@exec_hook)(argv, qualifier ("exec_hook_arg")); + throw OSError, "exec failed: " + argv0 + " : " + errno_string (); } @@ -335,6 +365,9 @@ () = write (fd, sprintf ("Traceback:\n%S\n", e.traceback)); fd = NULL; } + variable exit_hook = qualifier("exit_hook"); + variable exit_hook_arg = qualifier ("exit_hook_arg"); + if (exit_hook != NULL) (@exit_hook)(argv, exit_hook_arg); _exit (1); } variable other_struct_fields = "pid", "wait";
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/profile.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/profile.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/readascii.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/readascii.sl
Changed
@@ -1,5 +1,5 @@ % Simple ascii file reader -% Copyright (C) 2007-2017,2018 John E. Davis +% Copyright (C) 2007-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/setfuns.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/setfuns.sl
Changed
@@ -1,5 +1,5 @@ % Functions that operate on sets in the form of arrays and lists: -% Copyright (C) 2010-2017,2018 John E. Davis +% Copyright (C) 2010-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for @@ -93,8 +93,8 @@ variable has_list = 0; loop (_NARGS) { - has_list += (typeof (obj) == List_Type); obj = pop_set_object (); + has_list += (typeof (obj) == List_Type); list_insert (args, obj); }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/sldb.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/sldb.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/sldbcore.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/sldbcore.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for @@ -21,7 +21,8 @@ % it may be limited due to the lack of line number information. % % -require ("print"); +%require ("print"); +()=evalfile("print"); private variable Debugger_Methods = struct {
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/sldbsock.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/sldbsock.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/stkcheck.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/stkcheck.sl
Changed
@@ -1,4 +1,4 @@ -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/structfuns.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/structfuns.sl
Changed
@@ -1,5 +1,5 @@ % Struct functions -% Copyright (C) 2012-2017,2018 John E. Davis +% Copyright (C) 2012-2021,2022 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/test/runtests.sh -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/test/runtests.sh
Changed
@@ -9,17 +9,36 @@ export DYLD_LIBRARY_PATH="$ROOT/src/${ARCH}elfobjs" run_test_pgm="$SLSHROOT/${ARCH}objs/slsh_exe -n -g" -#run_test_pgm="$SLSHROOT/${ARCH}objs/slsh_exe -n -g $SLSHROOT/scripts/sldb" runprefix="$SLTEST_RUN_PREFIX" -#runprefix="valgrind --tool=memcheck --leak-check=yes --error-limit=no --num-callers=25" -#runprefix="gdb --args" +use_slcov=0 +while "$#" -ge 1 +do + case "$1" in + "--slcov" ) runsuffix="$SLSHROOT/scripts/slcov"; shift + rm test_*.slcov* + use_slcov=1 + ;; + "--sldb" ) runsuffix="$SLSHROOT/scripts/sldb"; shift + ;; + "--gdb" ) runprefix="gdb --args"; shift + ;; + "--memcheck" ) runprefix="valgrind --tool=memcheck --leak-check=yes --error-limit=no --num-callers=25" + shift + ;; + "--strace" ) runprefix="strace -f -o strace.log" + shift + ;; + * ) break + ;; + esac +done ######################################################################## if $# -eq 0 then - echo "Usage: $0 test1.sl test2.sl ..." + echo "Usage: $0 --gdb|--sldb|--slcov|--memcheck test1.sl test2.sl ..." exit 64 fi @@ -29,9 +48,10 @@ n_failed=0 tests_failed="" + for testxxx in $@ do - $runprefix $run_test_pgm $testxxx + $runprefix $run_test_pgm $runsuffix $testxxx if $? -ne 0 then @@ -44,6 +64,15 @@ if $n_failed -eq 0 then echo "All tests passed." + if $use_slcov -eq 1 + then + lcov_merge_args="" + for X in test_*.slcov* + do + lcov_merge_args="$lcov_merge_args -a $X" + done + lcov $lcov_merge_args -o "slshlib.slcov" + fi else echo "$n_failed tests failed: $tests_failed" fi
View file
_service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/test/test_arrayfuns.sl
Added
@@ -0,0 +1,39 @@ +() = evalfile ("./common.sl"); + +require ("arrayfuns"); + +define slsh_main () +{ + start_test ("arrayfuns"); + + variable a = 1:10, b; + + b = reverse (a); + ifnot (_eqs(b, 10:1:-1)) + failed ("reverse"); + + b = shift (a, 1); + ifnot (_eqs (b, 2:10, 1)) + failed ("shift 1"); + b = shift (a, -1); + ifnot (_eqs (b, 10, 1:9)) + failed ("shift -1"); + + variable i = 8, 9, 2, 1, 0, 7, 5, 6, 4, 3, i1; + b = @a; + i1 = @i; + rearrange (b, i); + ifnot (_eqs (i, i1)) + failed ("rearrange modified the indices"); + ifnot (_eqs (b, ai)) + failed ("rearrange"); + i3 = i7; + try + { + rearrange (b, i); + failed ("Expected rearrange to fail on a bad permutation"); + } + catch AnyError; + + end_test (); +}
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/test/test_cmdopt.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/test/test_cmdopt.sl
Changed
@@ -66,6 +66,11 @@ @ref += 1; } +private define callback_opt2 (value, a, b, ref) +{ + @ref = value + a + b; +} + private define test_cmdopt () { variable opts = cmdopt_new (NULL); @@ -132,6 +137,20 @@ opts.add ("f", &s.flags; bor=1, band=~0x2); args = "-a", "-f", "--b4000"; test_args (opts, args, 3, s, {0x8000|0x4000|1, 0x4|0x1}, 0); + + s = struct {v = NULL}; + opts = cmdopt_new (NULL); + opts.add ("f|foo", &callback_opt2, 1, 2, &s.v; type="int", optional=17); + + args = "-f"; + test_args (opts, args, 1, s, {1+2+17}, 0); + + args = "--foo=12"; + test_args (opts, args, 1, s, {1+2+12}, 0); + + args = "--bar=12"; + test_args (opts, args, 1, s, {-1}, 1); + } define slsh_main ()
View file
_service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/test/test_glob.sl
Added
@@ -0,0 +1,55 @@ +() = evalfile ("./common.sl"); + +require ("glob"); +require ("setfuns"); + +define slsh_main () +{ + start_test ("glob"); + + variable files, files1, files2; + + files = glob (__FILE__, "foo.xxyu.zz"); + if ((length (files) != 1) + || (path_basename (files0) != path_basename (__FILE__))) + { + failed ("glob __FILE__"); + } + + files = glob ("*.sl"); + files1 = listdir ("."); + files1 = files1where (".sl" == array_map (String_Type, &path_extname, files1)); + files = filesarray_sort (files); + files1 = files1array_sort (files1); + + ifnot (_eqs (files, files1)) + { + failed ("glob 1"); + } + + variable dir = getcwd (); + % The getcwd function returns the CWD with a trailing slash. + % That is not wanted here. + if (strbytelen(dir) > 1) dir = dir:-2; + files1 = glob (path_concat (dir + "*", "*.sl")); + + % A an equivalent variant + dir = glob (dir + "*/"); % returns an array, so use array_map below + files2 = glob (array_map (String_Type, &path_concat, dir, "*.sl")); + + if ((length (files1) != length (files2)) + || length (complement (files1, files2))) + { + failed ("glob file1 vs files2"); + } + + % There may be more than one directory matching dir*. So just + % look for a subset of matching files, i.e., files \in files1 + files1 = array_map (String_Type, &path_basename, files1); + if (length (complement (files, files1)) != 0) + { + failed ("glob 2: some files were not found in files1"); + } + + end_test(); +}
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/test/test_listfuns.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/test/test_listfuns.sl
Changed
@@ -3,6 +3,13 @@ require ("rand"); require ("listfuns"); +private define cmp_func (a, b) +{ + if (a > b) return 1; + if (a < b) return -1; + return 0; +} + define test_heap (n, dir) { variable rnums = rand_uniform (n); @@ -20,7 +27,10 @@ list = {}; while (h.length ()) { - list_append (list, h.remove()); + variable obj = h.peek (); + if (obj != h.remove ()) + failed ("h.peek"); + list_append (list, obj); } rearrange (rnums, array_sort (rnums; dir=dir)); @@ -29,11 +39,26 @@ if (length (rnums) && any (rnums != list_to_array (list))) failed ("heap sorted list does not match sorted array"); + + % shuffle the list, then sort the list using a custom sort function + list = listrand_permutation (length(list)); + i = list_sort (list; dir=dir, cmp=&cmp_func); + list = listi; + if (length (rnums) && any (rnums != list_to_array (list))) + failed ("sorted list using a custom sort function"); } define slsh_main () { start_test ("listfuns"); + + try + { + heap_new (); + failed ("heap_new usage"); + } + catch UsageError; + srand (0); variable i; _for i (0, 33, 1)
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/test/test_print.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/test/test_print.sl
Changed
@@ -2,18 +2,21 @@ require ("print"); -private define test_print () +private define test_print (x) { - variable x = 1:20:0.1; - variable ref_x, file_x, fp_x; + variable ref_x, file_x, fp_x, pager_x; + + % Wrie to a reference print (x, &ref_x); + % Write to a named file variable file = sprintf ("/tmp/test_print_%X_%d", _time(), getpid()); print (x, file); variable fp = fopen (file, "r"); () = fread_bytes (&file_x, 2*strlen (ref_x), fp); () = fclose (fp); + % Write to a file pointer fp = fopen (file, "wb"); print (x, fp); () = fclose (fp); @@ -21,8 +24,14 @@ () = fread_bytes (&fp_x, 2*strlen (ref_x), fp); () = fclose (fp); + % write to a pager + print (x; pager="cat > $file"$); + fp = fopen (file, "r"); + () = fread_bytes (&pager_x, 2*strlen (ref_x), fp); + () = fclose (fp); + () = remove (file); - if ((ref_x != file_x) || (ref_x != fp_x)) + if ((ref_x != file_x) || (ref_x != fp_x) || (pager_x != file_x)) { failed ("Failed: print failed to produce identical results\n"); } @@ -31,7 +40,39 @@ define slsh_main () { start_test ("print"); - test_print (); + % The test_print function cannot be used to print strings + % since the print function treats strings differently depending + % upon the device. + test_print (1:20:0.1); + test_print (_reshape (1:20, 2,10)); + test_print (_reshape (1:20, 2,5,2)); + test_print (struct {x = {}, y = 1:3, }); + test_print (struct {x = {}, y = 1:3, }); + test_print ({struct {x = {}, y = 1:3, }}); + test_print (Int_Type); + + % For the use of a pager + print_set_pager ("cat > /dev/null"); + print_set_pager_lines (0); + + print ("1\n\2\n\3\n"); + print ("1\n\2\0\n\3\n"); + print (struct {x = {1}, y = 1:3, }); + print (struct {x = {2}, y = 1:3, }); + print ({struct {x = {3}, y = 1:3, z = "\0"B}}); + + print_set_pager_lines (NULL); + print (array_map (String_Type, &sprintf, "%d\n", 1:1000)); + + + % Force an exception + try + { + print ("x"; pager='x'); + failed ("Expected an invalid pager to produce an exception"); + } + catch AnyError; + end_test (); }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/test/test_process.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/test/test_process.sl
Changed
@@ -2,21 +2,56 @@ require ("process"); -private define pre_exec_hook (fdlist, optarg) +private define pre_exec_hook2 (fdlist, optarg) { putenv ("TEST_OPTARG=$optarg"); } +private define pre_exec_hook1(fdlist) +{ + return pre_exec_hook2 (fdlist, "unused"); +} + +#ifexists slcov_write_report +private variable Start_Dir = getcwd (); +private define exit_hook (argv, cd) +{ + variable file = path_concat (Start_Dir, sprintf ("%s-%d", cd, getpid())); + slcov_write_report (fopen (file, "w"), 1); +} +private define exec_hook (argv, cd) +{ + variable file = path_concat (Start_Dir, sprintf ("%s-%d", cd, getpid())); + slcov_write_report (fopen (file, "w"), 1); + return execvp (argv0, argv); +} + +#endif + private define test_process () { % This is a silly example. echo write to fd=12, which has stdout % dup'd to it. wc reads from echo via fd=16, which has stdin dup'd % to it. variable echo = new_process ("echo", "foo bar"; write=12, dup1=12, - pre_exec_hook=&pre_exec_hook, + read={4,5,6,7}, + stdin="</dev/null", + stdout=1, +#ifexists slcov_write_report + exec_hook = &exec_hook, + exec_hook_arg = "test_process.slcov", +#endif + pre_exec_hook=&pre_exec_hook2, pre_exec_hook_optarg="FOOBAR"); - variable wc = new_process ("wc"; write=10, dup1=10, fd16=echo.fd12, dup0=16); + variable wc = new_process ("wc"; write=10, dup1=10, fd16=echo.fd12, dup0=16, + read=3:9, + pre_exec_hook=&pre_exec_hook1, +#ifexists slcov_write_report + exec_hook = &exec_hook, + exec_hook_arg = "test_process.slcov", +#endif + ); variable line; if (-1 == fgets (&line, wc.fp10)) @@ -32,6 +67,32 @@ status = wc.wait (); if (status == NULL) failed ("wait method failed for echo"); + + % Force an exception + try + { + echo = new_process ("echo", "foo bar"; + stdout="/", +#ifexists slcov_write_report + exit_hook = &exit_hook, + exit_hook_arg = "test_process.slcov", +#endif + ); + failed ("failed to force an exception"); + } + catch OSError; + + variable p = new_process ("pwd"; dir="/", write=1, +#ifexists slcov_write_report + exec_hook = &exec_hook, + exec_hook_arg = "test_process.slcov", +#endif + ); + if (-1 == fgets (&line, p.fp1)) + failed ("Failed to read from pwd process: " + errno_string ()); + if ("/" != strtrim(line)) + failed ("Failed dir qualifier"); + p.wait (0); } define slsh_main ()
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/test/test_readascii.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/test/test_readascii.sl
Changed
@@ -17,6 +17,22 @@ return array_map (String_Type, &sprintf, fmt, x, y, z); } +private define make_lines_file (x, y, z, delim) +{ + variable lines = make_lines_array (x, y, z, delim); + variable file = sprintf ("/tmp/test_readascii_%X_%d", _time(), getpid()); + variable fp = fopen (file, "w"); + if (fp == NULL) + throw OpenError, "Unable to open $file"$; + () = fputslines (lines, fp); + () = fclose (fp); + + variable data; + () = readascii (file, &data; ncols=3, delim=delim, size=11, dsize=7); + () = remove (file); + return make_lines_array (data0, data1, data2, delim); +} + private define make_lines_list (x, y, z, delim) { variable list = {}; @@ -140,5 +156,6 @@ start_test ("readascii"); run_test (&make_lines_array); run_test (&make_lines_list); + run_test (&make_lines_file); end_test (); }
View file
_service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/test/test_require.sl
Added
@@ -0,0 +1,20 @@ +() = evalfile ("./common.sl"); + +require ("./common.sl", "r"); +require ("common", "s", "./common.sl"); + +define slsh_main () +{ + try + { + r->start_test ("require"); + s->end_test (); + exit (0); + } + catch AnyError: + { + failed ("require"); + } + end_test (); +} +
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/test/test_setfuns.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/test/test_setfuns.sl
Changed
@@ -20,48 +20,71 @@ private define test_setfuns () { -test_func (&unique1, {1,2,2,3,5,-1}, 1,2,3,5,-1); -test_func (&unique1, {1}, 1); -test_func (&unique1, {1,1}, 1); -test_func (&unique1, {0:-1}, Int_Type0); -test_func (&unique1, {{1,2,2,3,5,-1}}, {1,2,3,5,-1}); -test_func (&unique1, {{1}}, {1}); -test_func (&unique1, {{1,1}}, {1}); -test_func (&unique1, {{}}, {}); + test_func (&unique1, {1,2,2,3,5,-1}, 1,2,3,5,-1); + test_func (&unique1, {1}, 1); + test_func (&unique1, {1,1}, 1); + test_func (&unique1, {0:-1}, Int_Type0); + test_func (&unique1, {{1,2,2,3,5,-1}}, {1,2,3,5,-1}); + test_func (&unique1, {{1}}, {1}); + test_func (&unique1, {{1,1}}, {1}); + test_func (&unique1, {{}}, {}); -test_func (&intersection, {1:5, 3:7}, 2:4); -test_func (&intersection, {1:5, 5:7}, 4); -test_func (&intersection, {1:5, 0:1}, 0); -test_func (&intersection, {1:5, 5}, 4); -test_func (&intersection, {1:5, 6}, Int_Type0); + test_func (&intersection, {1:5, 3:7}, 2:4); + test_func (&intersection, {1:5, 5:7}, 4); + test_func (&intersection, {1:5, 0:1}, 0); + test_func (&intersection, {1:5, 5}, 4); + test_func (&intersection, {1:5, 6}, Int_Type0); -test_func (&intersection, {{1,2,3,4,5}, 3:7}, 2:4); -test_func (&intersection, {{1,2,3,4,5}, 5:7}, 4); -test_func (&intersection, {{1,2,3,4,5}, 0:1}, 0); -test_func (&intersection, {{1,2,3,4,5}, 5}, 4); -test_func (&intersection, {{1,2,3,4,5}, 6}, Int_Type0); + test_func (&intersection, {{1,2,3,4,5}, 3:7}, 2:4); + test_func (&intersection, {{1,2,3,4,5}, 5:7}, 4); + test_func (&intersection, {{1,2,3,4,5}, 0:1}, 0); + test_func (&intersection, {{1,2,3,4,5}, 5}, 4); + test_func (&intersection, {{1,2,3,4,5}, 6}, Int_Type0); -test_func (&intersection, {{"foo", 2i, 3i}, {"foo", 3i}}, 0,2); -test_func (&intersection, {{1, "foo", 2i, 3i}, {"foo", 3i}}, 1,3); -test_func (&intersection, {{}, {"foo", 3i}}, Int_Type0); -test_func (&intersection, {{"foo", 3i},{}}, Int_Type0); -test_func (&intersection, {{"foo","foo"}, {"foo"}}, 0,1); -test_func (&intersection, {{"foo"}, {"foo","bar"}}, 0); +#ifexists Complex_Type + test_func (&intersection, {{"foo", 2i, 3i}, {"foo", 3i}}, 0,2); + test_func (&intersection, {{1, "foo", 2i, 3i}, {"foo", 3i}}, 1,3); + test_func (&intersection, {{}, {"foo", 3i}}, Int_Type0); + test_func (&intersection, {{"foo", 3i},{}}, Int_Type0); +#endif + test_func (&intersection, {{"foo","foo"}, {"foo"}}, 0,1); + test_func (&intersection, {{"foo"}, {"foo","bar"}}, 0); -test_func (&complement, {{1,2,3,4,5}, 3:7}, 0,1); -test_func (&complement, {{1,2,3,4,5}, 5:7}, 0:3); -test_func (&complement, {{1,2,3,4,5}, 0:1}, 1:4); -test_func (&complement, {{1,2,3,4,5}, 5}, 0:3); -test_func (&complement, {{1,2,3,4,5}, 6}, 0:4); -test_func (&complement, {{"foo", 2i, 3i}, {"foo", 3i}}, 1); -test_func (&complement, {{1, "foo", 2i, 3i}, {"foo", 3i}}, 0,2); -test_func (&complement, {{}, {"foo", 3i}}, Int_Type0); -test_func (&complement, {{"foo", 3i}, {}}, 0,1); -test_func (&complement, {{"foo","foo"}, {"foo"}}, Int_Type0); + test_func (&complement, {{1,2,3,4,5}, 3:7}, 0,1); + test_func (&complement, {{1,2,3,4,5}, 5:7}, 0:3); + test_func (&complement, {{1,2,3,4,5}, 0:1}, 1:4); + test_func (&complement, {{1,2,3,4,5}, 5}, 0:3); + test_func (&complement, {{1,2,3,4,5}, 6}, 0:4); +#ifexists Complex_Type + test_func (&complement, {{"foo", 2i, 3i}, {"foo", 3i}}, 1); + test_func (&complement, {{1, "foo", 2i, 3i}, {"foo", 3i}}, 0,2); + test_func (&complement, {{}, {"foo", 3i}}, Int_Type0); + test_func (&complement, {{"foo", 3i}, {}}, 0,1); +#endif + test_func (&complement, {{"foo","foo"}, {"foo"}}, Int_Type0); -test_func (&union, {{"foo", 1, 2}, {"bar", 1, 3}}, {"foo", 1, 2, "bar", 3}); -test_func (&union, {1:10, 3:5, 9:12}, 1:12); -test_func (&union, {1:10, 3:5, 2i}, 1:10, 2i); + test_func (&union, {{"foo", 1, 2}, {"bar", 1, 3}}, {"foo", 1, 2, "bar", 3}); + test_func (&union, {1:10, 3:5, 9:12}, 1:12); + test_func (&union, {1:3, {31}, 4, 5}, {1,2,3,4,5,31}); +#ifexists Complex_Type + test_func (&union, {1:10, 3:5, 2i}, 1:10, 2i); +#endif + + variable i = ismember (2, 1:10); + ifnot (_eqs (i, 1)) + failed ("is_member 1"); + + i = ismember (-1, 1:10); + ifnot (_eqs (i, 0)) + failed ("is_member 2"); + + i = ismember (1,2,3, 2); + ifnot (_eqs (i, 0,1,0)) + failed ("is_member 3"); + + i = ismember ({1,2,3}, 2,3,4); + ifnot (_eqs (i, 0,1,1)) + failed ("is_member 4"); } define slsh_main ()
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/test/test_structfuns.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/test/test_structfuns.sl
Changed
@@ -2,17 +2,34 @@ require ("structfuns"); -private define test_structfuns () +private define test_struct_filter () { - variable s = struct + variable s, s1, i; + + s = struct + { + str = "foo", + a1 = "bar", "foo", + a2 = {1,2,3}, + }; + + i = 0; + s1 = struct_filter (s, i; copy); + if ((s1.str != s.str) + || (s1.a1 != "bar") + || not _eqs (s1.a2, s.a2)) + failed ("filtering with i=0"); + + s = struct { str = "foo", a1 = 1:3, a2 = _reshape (1:3*4*5, 3,4*5), a3 = _reshape (1:3*4*5, 3,4,5), }; - variable i = 1,2; - variable s1 = struct_filter (s, i; dim=0, copy); + + i = 1,2; + s1 = struct_filter (s, i; dim=0, copy); if ((s1.str != s.str) || not _eqs (s1.a1, s.a1i) || not _eqs (s1.a2, s.a2i,*) @@ -36,11 +53,46 @@ failed ("filtering on dim=1 failed"); } +private define test_struct_combine () +{ + variable s1 = struct + { + a = "s1_a", + b, + c = "s1_c", + }; + variable s2 = struct + { + x = "s2_x", + c = "s2_c", + y, + }; + + variable s1s2 = struct_combine (s1, s2); + variable s = struct + { + a = s1.a, + b = s1.b, + c = s2.c, + x = s2.x, + y = s2.y, + }; + + ifnot (_eqs (s, s1s2)) + failed ("struct_combine"); + + ifnot (struct_field_exists (s, "y")) + failed ("struct_field_exists y"); + if (struct_field_exists (s, "xxxx")) + failed ("struct_field_exists xxxx"); +} + define slsh_main () { start_test ("structfuns"); - test_structfuns (); + test_struct_filter (); + test_struct_combine (); end_test (); }
View file
_service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/test/test_timestamp.sl
Added
@@ -0,0 +1,94 @@ +() = evalfile ("./common.sl"); + +require ("timestamp"); + +private define test_timestamp (t_expected, dates) +{ + variable bad = 0; + foreach (dates) + { + variable ts = (); + variable t = timestamp_parse (ts); + if (t != t_expected) + { + () = fprintf (stderr, "ERROR: %S --> %S, expected %S\n", ts, t, t_expected); + bad++; + } + } + return bad; +} + +define slsh_main () +{ + start_test ("timestamp"); + + variable t_expected, dates, bad = 0; + + t_expected = 1588455117; + dates = + { + "Tue, 2 May 2020 22.31.57 +0100", + "May 2 17:31:57 2020 EDT", + "2020-05-02T21:31:57Z", + "2020-05-02T21:31:57+00:00", + "2020-05-02T17:31:57-04:00", + "20200502T173157-0400", + "Tue, 02 May 2020 21:31:57 +0000", + "Tue, 2 May 2020 21:31:57 +0000", + "Tuesday, 02-May-20 21:31:57 UTC", + "Tuesday, 02-May-20 9:31:57PM UTC", + "Tuesday, 2-May-20 21:31:57 UTC", + "Tuesday, 2-May-2020 21:31:57 UTC", + "Tuesday, 2-May-2020, 21:31:57Z", + "2020-05-02T21:31:57+00:00", + "5/02/2020, 5:31:57 PM EDT", + "5/2/2020, 5:31:57 PM EDT", + "5/2/20, 5:31:57 PM EDT", + "Tue May 2 17:31:57 2020 EDT", + "May 2, 17:31:57, 2020 EDT", + }; + bad += test_timestamp (t_expected, dates); + + t_expected = 1591137060; + dates = + { + "June 2, 2020 5:31 PM EST", + "Jun 2, 2020 5:31 PM EST", + "Thu Jun 2, 2020 5:31 PM EST", + "Thursday, Jun 2, 2020 5:31 PM EST", + "Thursday, June 2, 2020 5:31 PM EST", + }; + bad += test_timestamp (t_expected, dates); + + t_expected = 1611445148; + dates = + { + "Sat, 23 Jan 2021 23:39:08 +0000 (UTC)", + }; + bad += test_timestamp (t_expected, dates); + + t_expected = 97027200; + dates = + { + "1973-01-28T00:00:00Z", + }; + bad += test_timestamp (t_expected, dates); + + t_expected = 1597014697; + dates = + { + "2020-08-09T23:11:37Z", + "Sun Aug 9 19:11:37 2020 EDT", + }; + bad += test_timestamp (t_expected, dates); + + % Test the current line without a timezone specified + variable now = _time(); + dates = strftime ("%b %d, %Y %H:%M:%S", localtime(now)); + bad += test_timestamp (now, dates); + + if (bad) failed ("%d timestamps failed to parse", bad); + + end_test (); +} +
View file
_service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/timestamp.sl
Added
@@ -0,0 +1,207 @@ +% Copyright (C) 2020-2021, 2022 John E. Davis +% +% This file is part of the S-Lang Library and may be distributed under the +% terms of the GNU General Public License. See the file COPYING for +% more information. +%--------------------------------------------------------------------------- +% The code here attemps to convert a human readable representation of a +% timestamp, such as Wed May 13 02:38:34 2020 to a Unix time (number +% of secs since the Unix epoch) +% +% Public funtions: +% +% timestamp_parse: +% Parses a timestamp and Returns the number of seconds since +% the Unix EPOCH (1970-01-01T00:00:00Z) +% +private variable Months + = "jan", "feb", "mar", "apr", "may", "jun", + "jul", "aug", "sep", "oct", "nov", "dec"; + +% There is an extensive list of timezone abbreviations at +% <https://www.timeanddate.com/time/zones/>. The problem with +% abbreviations is that they are not unique. For example, CST +% could refer to Austrailia, North America, or China. +% The ones here are used by slrn. +private variable TZMap = Assoc_TypeInt_Type, 0; +TZMap"EDT" = -400; % US Eastern Daylight Time +TZMap"EST" = -500; % US Eastern Standard Time +TZMap"CDT" = -500; % US Central Daylight Time +TZMap"CST" = -600; % US Central +TZMap"MDT" = -600; % US Mountain Daylight Time +TZMap"MST" = -700; % US Mountain +TZMap"PDT" = -700; % US Pacific Daylight Time +TZMap"PST" = -800; % US Pacific +TZMap"GMT" = 0; +TZMap"UTC" = 0; +TZMap"Z" = 0; +TZMap"CET" = 100; % Central European +TZMap"MET" = 100; % Middle European +TZMap"MEZ" = 100; % Middle European +TZMap"EET" = 200; % Eastern European +TZMap"MSK" = 300; % Moscow +TZMap"HKT" = 800; % Hong Kong +TZMap"JST" = 900; % Japan Standard +TZMap"KST" = 900; % Korean Standard +TZMap"CAST" = 930; % Central Autsralian +TZMap"EAST" = 1000; % Eastern Autsralian +TZMap"NZST" = 1200; % New Zealand Autsralian + +private define map_tzstr_string (tzstr) +{ + return TZMapstrtrim (strup(tzstr)); +} + +private variable Cumulative_Days_Per_Month = + int (cumsum (0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)); + +private variable TS_Formats = {}; +private define add_ts_format (re, indices, month_is_int) +{ + variable s = struct + { + re = re, + month_is_int = month_is_int, + indices = indices, + }; + + list_append (TS_Formats, s); +} +% Tue 12 May 2020 04:37:54 PM EDT +add_ts_format (`^a-zA-Z,*` % weekday + + ` *\(\d\d?\) -\(a-zA-Z+\) -\(\d\d\d*\),?` % day month year + + ` *\(\d\d?\):.\(\d\d\):.?\(\d*\)` % hh:mm:ss + + ` *\(.*\)`, % AM/PM + tz + 1,2,3,4,5,6,7, 0); + +% Sun, Dec 04, 1994 11:05:52 GMT +add_ts_format (`^a-zA-Z,+` + + ` +\(a-zA-Z\{3,\}\) \(\d+\),? *\(\d\d\d*\)`% month, day, year + + ` +\(\d\d?\):\(\d\d\):?\(\d*\)`% hh:mm:ss + + ` *\(.*\)`, % tz + 2,1,3,4,5,6,7, 0); + +% Dec 04, 1994 11:05:52 GMT +add_ts_format (`^\(a-zA-Z\{3,\}\) \(\d+\),? *\(\d\d\d*\)`% month, day, year + + ` +\(\d\d?\):\(\d\d\):?\(\d*\)`% hh:mm:ss + + ` *\(.*\)`, % tz + 2,1,3,4,5,6,7, 0); + +% 2020-09-12T21:17:30 <tz-offset> +add_ts_format (`^\(\d\d\d\d\)-?\(\d\d\)-?\(\d\d\)` + + `T\(\d\d\):?\(\d\d\):?\(\d\d\)` + + ` *\(.*\)`, + 3,2,1,4,5,6,7, 1); + +% 5/12/2020, 5:31:57 PM +add_ts_format (`\(\d\d?\)/\(\d\d?\)/\(\d\d\d*\),?` + + ` *\(\d\d?\):\(\d\d\):?\(\d*\)` + + ` *\(.*\)`, + 2,1,3,4,5,6,7, 1); + +% Dec 4 11:05:52 2020 +add_ts_format (`^\(a-zA-Z\{3,\}\) +\(\d+\),?` % month, day + + ` +\(\d\d?\):\(\d\d\):?\(\d*\),?`% hh:mm:ss + + ` +\(\d\d\d*\)` % year + + ` *\(.*\)`, % tz + 2,1,6,3,4,5,7, 0); + +% Tue Dec 4 11:05:52 2020 +add_ts_format (`^A-Za-z,+` + + ` +\(a-zA-Z\{3,\}\) +\(\d+\),?` % month, day + + ` +\(\d\d?\):\(\d\d\):?\(\d*\),?`% hh:mm:ss + + ` +\(\d\d\d*\)` % year + + ` *\(.*\)`, % tz + 2,1,6,3,4,5,7, 0); + +private variable Last_TS_Index = 0; +private define guess_local_timezone_offset () +{ + variable now = _time(), tm = gmtime(now); + tm.tm_isdst = -1; % Force a lookup to see if DST is in effect + variable secs = now - mktime (tm); + variable hours = secs/3600; + return 100*hours + (secs - 3600*hours)/60; +} + +define timestamp_parse (timestamp) +{ + timestamp = strtrim (timestamp); + variable day, month, year, hours, minutes, secs, tz, tzstr; + variable num = length (TS_Formats); + loop (num) + { + variable fmt = TS_FormatsLast_TS_Index; + + variable matches = string_matches (timestamp, fmt.re); + if (matches == NULL) + { + Last_TS_Index = (Last_TS_Index + 1) mod num; + continue; + } + variable ind = fmt.indices; + day = atoi (matchesind0); + month = matchesind1; + year = atoi (matchesind2); + hours = atoi (matchesind3); + minutes = atoi (matchesind4); + secs = atoi (matchesind5); + tzstr = matchesind6; + + if (fmt.month_is_int) + month = atoi (month) - 1; % 0 to 11 + else + { + if (strbytelen (month) > 3) month = month0,1,2; + month = wherefirst (Months == strlow(month)); + if (month == NULL) return NULL; + } + break; + } + then return NULL; + + if (year < 100) + { + % No century + year += 1900; + if (year < 1950) year += 100; + } + tzstr = strtrim (tzstr); + + % Take care of AM/PM + if (((tzstr0 == 'A') || (tzstr0 == 'P')) + && (tzstr1 == 'M') + && ((tzstr2 == 0) || (tzstr2 == ' '))) + { + if (tzstr0 == 'P') + hours += 12; + tzstr = strtrim (tzstr2:); + } + + tzstr = strreplace (tzstr, ":", ""); + if (tzstr == "") + tz = guess_local_timezone_offset (); + else + { + tz = atoi (tzstr); + if ((tz == 0) && (tzstr0 != '+') && (tzstr0 != '-')) + tz = map_tzstr_string (tzstr); + } + + day--; % offset from 0 + % Compute the cumulative number of days, accounting for a leap year + day += Cumulative_Days_Per_Monthmonth; + if ((month > 2) + && (0 == (year mod 4)) + && ((year mod 100) || (0 == (year mod 400)))) + day++; + + year -= 1970; % Unix EPOCH + day += 365*year + (year+1)/4; % leap year, every 4 years from 72 + + % The TZ is hhmm form, so 600 is 6 hours, and 0 minutes + hours -= tz/100; + minutes -= tz mod 100; + + return secs + 60L*(minutes + 60L*(hours + 24L*day)); +}
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/tm/Makefile -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/tm/Makefile
Changed
@@ -7,7 +7,7 @@ HLP_FILES = arrayfuns.hlp glob.hlp require.hlp structfuns.hlp cmdopt.hlp \ readascii.hlp profile.hlp print.hlp process.hlp setfuns.hlp fswalk.hlp \ - listfuns.hlp + listfuns.hlp timestamp.hlp all: help-files help-files: $(HLP_FILES)
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/tm/fswalk.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/tm/fswalk.tm
Changed
@@ -1,34 +1,43 @@ \function{fswalk_new} \synopsis{Create an object to walk the filesystem tree} -\usage{obj = fswalk_new (Ref_Type dirfunc, Ref_Type filefunc; qualifiers)} +\usage{obj = fswalk_new (Ref_Type enterdir_func, Ref_Type file_func, Ref_Type leavedir_func; qualifiers)} \description The \sfun{fswalk_new} function creates an object that is useful - for exploring a filesystem tree. It requires two arguments that + for exploring a filesystem tree. It requires at least two arguments that are references to functions to be called when a directory or file is - encountered. Each of these functions is passed at least two + encountered. The third argument (\exmp{leavedir_func}) is optional. + Each of these functions is passed at least two arguments: the name of the file or directory (including leading path elements relative to the directory where processing started), and - the stat structure of the of the file or directory. Qualifiers may + the stat structure of the file or directory. Qualifiers may be used to specify additional arguments. The object's \exmp{walk} method is the one that actually walks the filesystem. - The directory callback function must return an integer value that + The \exmp{enterdir_func} callback function is called when a + directory is encountered. It must return an integer value that indicates how it should be processed. If the function returns 0, then the directory will be skipped (pruned). A positive value indicates that the directory will processed. If the function returns a negative value, then no further processing by the walk - function will take place and control will pass to the user. + function will take place and control will pass back to the caller. The + value of this function may be NULL. - The file callback function must also return an integer that + The \exmp{file_func} callback function must return an integer that indicates how processing should continue. If it returns a positive value, then additional files in the corresponding directory will be processed. If it returns 0, then no further files or subdirectories of the directory will be processed, and processing will continue to take place in the parent directory. Otherwise, the return value is negative, which indicates that processing should be stopped and - control will pass back to the caller. + control will pass back to the caller. The value of this function + may be NULL. + + If the \exmp{leavedir_func} has been specified and is non-NULL, then + it will be called after the directory has been processed. It must + return an integer. A return value of -1 is used to indicate that an + error has occurred, and that further processing should stop. \qualifiers The following qualifiers are supported: @@ -36,12 +45,17 @@ dargs={args...} #v- \exmp{dargs} is a list of additional arguments that will be added when - calling the directory callback function. + calling the \exmp{enterdir_func} callback. #v+ fargs={args...} #v- \exmp{fargs} is a list of additional arguments that will be added when - calling the file callback function. + calling the \exmp{file_func} callback function. +#v+ + largs={args...} +#v- + \exmp{largs} is a list of additional arguments that will be added when + calling the \exmp{leavedir_func} callback. #v+ followlinks=val #v-
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/lib/tm/process.tm -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/tm/process.tm
Changed
@@ -99,6 +99,35 @@ #v- If this qualifier exists, its value will be passed as the second argument to the \exmp{pre_exec_hook} callback function. +#v+ + exec_hook=&func +#v- + This qualifier may be used to specify the function that actually + executes the child process. It is expected to take 2 arguments: + the \exmp{argv} array and the value of the \exmp{exec_hook_arg} + qualifier. The function should invoke the \ifun{execvp} system + and return its value. Only in very special cases, such as testing + the process code itself, should this hook be needed. +#v+ + exec_hook_arg=VAL +#v- + The value of this qualifier will be passed to the \exmp{exec_hook} + callback function. +#v+ + exit_hook=&func +#v- + This qualifier may be used to specify the function to be called + just before the child process exits in the case of a failure. + executes the child process. The function will be passed 2 + arguments: the \exmp{argv} array and the value of the + \exmp{exit_hook_arg} qualifier. The function should not return a + value. Only in very special cases, such as testing the process + code itself, should this hook be needed. +#v+ + exit_hook_arg=VAL +#v- + The value of this qualifier will be passed to the \exmp{exit_hook} + callback function. Note that the read and write qualifiers specify the nature of the file descriptors from the child process's view. That is, those
View file
_service:tar_scm:slang-2.3.3.tar.bz2/slsh/lib/tm/timestamp.tm
Added
@@ -0,0 +1,26 @@ +\function{timestamp_parse} +\synopsis{Parse a timestamps to Unix time} +\usage{Long_Type timestamp_parse (String_Type timestamp)} +\description + The \sfun{timestamp_parse} function parses the string representation + of a timestamp and returns it expessed as the number of seconds + since the Unix Epoch. + + The \exmp{timestamp} string is assumed to conform to one of the + following standards: RFCs 822, 1036, 1123, 2822, 3339, and ISO-8601. + Examples include: +#v+ + "2020-05-02T17:09:58+00:00" + "Sunday, 02-May-20 17:09:58 UTC" + "Sun, 2 May 2020 17:09:58 +0000" + "5/2/2020, 5:31:57 PM EDT" + "2020-02-14T170958+0000" + "5/02/2020, 5:31:57 PM", +#v- + If a timezone specifier is missing, the local timezone will be + assumed. + + Upon success, the functions returns the number of seconds since + 1970-01-01T00:00:00 UTC. If the format of the timestamp is not + recognized as the function, NULL will be returned. +\seealso{_time, ctime, strftime, gmtime, timegm, mktime}
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/readline.c -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/readline.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2005-2017,2018 John E. Davis +Copyright (C) 2005-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -950,11 +950,11 @@ case 3: if (-1 == SLang_pop_anytype (&cb->cd)) return; - /* drop */ + /* fall through */ case 2: if (NULL == (cb->update_hook = SLang_pop_function ())) goto free_and_return; - /* drop */ + /* fall through */ case 1: if (NULL == (cb->mmt = pop_sri_type (&cb->sri))) goto free_and_return;
View file
_service:tar_scm:slang-2.3.3.tar.bz2/slsh/scripts/slcov
Added
@@ -0,0 +1,358 @@ +#!/usr/bin/env slsh +() = evalfile ("cmdopt"); +() = evalfile ("csv"); + +private variable Version = "0.1.0"; +private variable Output_Fp; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +_boseos_info = 0; + +private variable Hits_Hash = Assoc_TypeUInt_Type, 0; +private define bos_handler (file, line) +{ + variable h = strcat (file, "\t", string(line)); + Hits_Hashh += 1; +} + +private variable Func_Hits = Assoc_TypeUInt_Type, 0; +private define bof_handler (func, file) +{ + variable h = strcat (file, "\t", func); + %() = fprintf (stderr, "bof_handler: %S\n", h); + Func_Hitsh += 1; +} + +#ifexists _set_bof_compile_hook +private variable Func_List = Assoc_TypeInt_Type, 0; +private define bof_compile_hook (file, fname) +{ + Func_Liststrcat (file, "\t", fname) = 1; +} + +private define bos_compile_hook (file, line) +{ + Hits_Hashstrcat (file, "\t", string(line)) = 0; +} +#endif + +define slcov_enable () +{ + ()=_set_bos_handler (&bos_handler); + ()=_set_bof_handler (&bof_handler); + _boseos_info = 3; + _bofeof_info = 1; +#ifexists _set_bof_compile_hook + ()=_set_bof_compile_hook (&bof_compile_hook); + ()=_set_bos_compile_hook (&bos_compile_hook); +#endif +} + +define slcov_disable () +{ + ()=_set_bos_handler (NULL); + ()=_set_eos_handler (NULL); + ()=_set_bof_handler (NULL); + _boseos_info = 0; + _bofeof_info = 0; +#ifexists _set_bof_compile_hook + ()=_set_bof_compile_hook (NULL); + ()=_set_bos_compile_hook (NULL); +#endif +} + +private define make_absolute_filename (file) +{ + file = path_concat (getcwd(), file); + file = strreplace (file, "/./", "/"); + ifnot (is_substr (file, "../")) return file; + variable components = strchop (file, '/', 0); + file = "/"; + foreach (components) + { + variable c = (); + if (c == "..") + file = path_dirname (file); + else + file = path_concat (file, c); + } + return file; +} + +private define output_trace_file (fp, csv) +{ + variable file = NULL, i; + _for i (0, length (csv.file)-1, 1) + { + if (file != csv.filei) + { + if (file != NULL) () = fputs ("end_of_record\n", fp); + () = fputs ("TN:\n", fp); + file = csv.filei; + % Use an absolute pathname to faciliate merging output files + () = fprintf (fp, "SF:%s\n", make_absolute_filename (file)); + variable jj, j = where ((csv.file == file) and (csv.function != "")); + foreach jj (j) + () = fprintf (fp, "FN:%d,%s\n", csv.linenojj, csv.functionjj); + + foreach jj (j) + { + () = fprintf (fp, "FNDA:%d,%s\n", csv.fhitsjj, csv.functionjj); + } + + () = fprintf (fp, "FNF:%d\n", length(j)); + () = fprintf (fp, "FNH:%d\n", length(j)); % FIXME + } + variable h = csv.hitsi; + if ((h == -1) || ((h == 0) && (csv.functioni != ""))) continue; + () = fprintf (fp, "DA:%d,%d\n", csv.linenoi, h); + } + if (file != NULL) () = fputs ("end_of_record\n", fp); +} + +define slcov_write_report (fp, use_gcov) +{ + variable s = struct + { + file = {}, lineno = {}, hits = {}, + }; + + variable key, val, fields, file, files = Assoc_TypeInt_Type; + foreach key, val (Hits_Hash) + { + fields = strchop (key, '\t', 0); + file = fields0; + list_append (s.file, file); + list_append (s.lineno, atoi (fields1)); + list_append (s.hits, val); + filesfile = 1; + } + s.file = list_to_array (s.file); + s.lineno = list_to_array (s.lineno); + s.hits = list_to_array (s.hits); + + variable csv = struct + { + file = String_Type0, lineno = Int_Type0, + hits = Int_Type0, function = String_Type0, + fhits = Int_Type0, + }; + + foreach file (assoc_get_keys (files)) + { + if (file == __FILE__) continue; + variable fpin = fopen (file, "r"); + if (fpin == NULL) + { + filesfile = 0; + continue; + } + variable i, + fre = `^^%"*define \t+\(a-zA-Z0-9_+\)`, + line, lines = fgetslines(fpin), + num = length(lines), + hits = -1Int_Typenum, + funcs = ""Int_Typenum, + fhits = Int_Typenum; + +#ifnexists _set_bos_compile_hook + variable stmt_res = + + `^^#%*-(@!+/*&|<>^=`, + `^ \t*continue\>`, + `^ \t*break\>`, + `^ \t*return\>`, + `^ \t*throw\>`, + ; + variable not_stmt_res = + + `^ \t*0-9"'{}+-/*&!=|`, % continuation + `^ \ta-z0-9_+,`, % continuation + `^"%*\\\$`, % continuation of multiline string + `^ \t*(a-z0-9_, \t*) \t^=`, % matches (a,b,..) ^= + `^ \t*try\>`, + `^ \t*return \t*;`, % return; + ; +#endif + () = fclose (fpin); + + _for i (0, num-1, 1) + { + line = linesi; + variable matches = string_matches (line, fre); + if (matches != NULL) + { + variable func = matches1; +#ifexists _set_bof_compile_hook + ifnot (Func_Listfile + "\t" + func) + continue; % not compiled, probably #ifdef'd out +#endif + hitswhere (funcs == func) = -1; % probably a forward declaration + funcsi = func; + fhitsi = Func_Hitsfile + "\t" + func; + continue; + } +#ifnexists _set_bos_compile_hook + variable re; + foreach re (stmt_res) + { + if (string_match (line, re)) + { + hitsi = 0; + % False positive check + foreach re (not_stmt_res) + { + if (string_match (line, re)) + { + hitsi = -1; + break; + } + } + break; + } + } +#endif + } + + i = where (s.file == file); + hitss.linenoi-1 = s.hitsi; + + csv.file = csv.file, fileInt_Typenum; + csv.lineno = csv.lineno, 1:num; + csv.hits = csv.hits, hits; + csv.function = csv.function, funcs; + csv.fhits = csv.fhits, fhits; + } + struct_filter (csv, where ((csv.hits != -1) or (csv.function != ""))); + + if (use_gcov) + output_trace_file (fp, csv); + else + csv_writecol (fp, csv); +} + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +private define _slcov_version () +{ + () = fprintf (stderr, "slcov version %s; S-Lang version: %s\n", + Version, _slang_version_string); +} + +private define _slcov_usage () +{ + variable fp = stderr; + () = fprintf (fp, "Usage: %s options script args...\n", path_basename (__argv0)); + () = fprintf (fp, "Options:\n"); + variable opts = + + " -f|--func <function> Name of Function to call default: slsh_main\n", + " -o|--output <file> Name of output file default: <script>.slcov\n", + " -v|--version Print version information\n", + " -h|--help Print this message\n" + ; + variable opt; + foreach opt (opts) + () = fputs (opt, fp); + + () = fputs ("\ +After running this script, use the genhtml script to produce html output:\n\ + genhtml -o /var/www/html/dir -t 'title' --num-spaces 8 OUTPUT-FILE\n\ +", + fp); + exit (1); +} + +private define _slcov_cmdopt_error (msg) +{ + () = fprintf (stderr, "%s\n", msg); + _slcov_usage (); +} + +private variable Use_Gcov = 1; +private define _slcov_write_report () +{ + slcov_write_report (Output_Fp, Use_Gcov); + () = fclose (Output_Fp); +} + +private define _slcov_main () +{ + variable output = NULL; + variable func = "slsh_main"; + variable line_by_line = 0; + + variable opts = cmdopt_new (&_slcov_cmdopt_error); + opts.add("f|funct", &func; type="string"); + opts.add("o|output",&output; type="string"); + opts.add("v|version", &_slcov_version), + opts.add("h|help", &_slcov_usage); + variable i = opts.process (__argv, 1); + + if (func == "") + _slcov_usage (); + + if (i >= __argc) + _slcov_usage (); + + variable main = strtok (func, " \t(;")0; + variable main_args = strtrim (substrbytes (func, 1+strlen(main), -1)); + + variable depth = _stkdepth(); + try + { + if (strlen (main)) eval (main_args); + } + catch AnyError: + { + () = fprintf (stderr, "Error parsing args of %s\n", func); + exit (1); + } + main_args = __pop_args (_stkdepth ()-depth); + + variable script = __argvi; + + if (not path_is_absolute (script)) + script = path_concat (getcwd (), script); + + variable st = stat_file (script); + if (st == NULL) + { + () = fprintf (stderr, "Unable to stat %s -- did you specify its path?\n", script); + exit (1); + } + + if (not stat_is ("reg", st.st_mode)) + () = fprintf (stderr, "*** Warning %s is not a regular file\n", script); + + if (output == NULL) + output = strcat (path_basename_sans_extname (script), ".slcov"); + + variable fp = fopen (output, "w"); + if (fp == NULL) + { + () = fprintf (stderr, "Unable to open code coverage output file %s\n"); + exit (1); + } + () = fprintf (fp, "# slcov report for:\n"); + () = fprintf (fp, "# %S\n", strjoin (__argv, " ")); + Output_Fp = fp; + + variable has_at_exit = 0; + atexit (&_slcov_write_report); + + __set_argc_argv (__argvi:); + + slcov_enable (); + () = evalfile (script); + + variable ref = __get_reference (main); + if (ref != NULL) + (@ref) (__push_args (main_args)); + else if (main != "slsh_main") + () = fprintf (stderr, "*** Warning: %s is not defined\n", main); +} + +_slcov_main (); +exit (0);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/slsh.c -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/slsh.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2005-2017,2018 John E. Davis +Copyright (C) 2005-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -512,7 +512,7 @@ static int output_copyright (void) { output_version (); - fprintf (stdout, "Copyright (C) 2005-2017,2018 John E. Davis <jed@jedsoft.org>\r\n"); + fprintf (stdout, "Copyright (C) 2005-2021,2022 John E. Davis <jed@jedsoft.org>\r\n"); fprintf (stdout, "This is free software with ABSOLUTELY NO WARRANTY.\r\n"); fprintf (stdout, "\n");
View file
_service:tar_scm:slang-2.3.2.tar.bz2/slsh/slsh.h -> _service:tar_scm:slang-2.3.3.tar.bz2/slsh/slsh.h
Changed
@@ -1,5 +1,5 @@ /* -*- mode: C; mode: fold -*- -Copyright (C) 2010-2017,2018 John E. Davis +Copyright (C) 2010-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/Makefile.in -> _service:tar_scm:slang-2.3.3.tar.bz2/src/Makefile.in
Changed
@@ -159,7 +159,7 @@ @echo "" @echo $(NORMAL_LIB) created in $(OBJDIR) -$(ELFDIR_ELF_LIB): $(ELFDIR) $(CONFIG_H) $(ELFOBJS) $(VERSION_SCRIPT) +$(ELFDIR_ELF_LIB): $(ELFDIR_TSTAMP) $(CONFIG_H) $(ELFOBJS) $(VERSION_SCRIPT) -$(RM) $(ELFDIR_ELF_LIB) cd $(ELFDIR) && $(ELF_LINK_CMD) -o $(ELFLIB_BUILD_NAME) $(OFILES) $(LDFLAGS) $(ELF_DEP_LIBS) if $(ELFLIB_MAJOR) != $(ELFLIB_BUILD_NAME) ; then \ @@ -203,7 +203,7 @@ @echo installing $(OBJDIR_NORMAL_LIB) in $(DEST_LIBDIR)/ $(INSTALL_DATA) $(OBJDIR_NORMAL_LIB) $(DEST_LIBDIR)/ $(RANLIB) $(DEST_LIBDIR)/$(NORMAL_LIB) -install-elf-and-links: +install-elf-and-links: $(DEST_LIBDIR) -$(RM) $(DEST_LIBDIR)/$(ELFLIB) -$(RM) $(DEST_LIBDIR)/$(ELFLIB_MAJOR) @echo installing $(ELFLIB_BUILD_NAME) in $(DEST_LIBDIR)
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/_slang.h -> _service:tar_scm:slang-2.3.3.tar.bz2/src/_slang.h
Changed
@@ -3,7 +3,7 @@ /* header file for S-Lang internal structures that users do not (should not) need. Use slang.h for that purpose. */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -466,7 +466,10 @@ extern int _pSLstruct_push_field (SLang_Struct_Type *s, SLFUTURE_CONST char *name, int do_free); extern int _pSLstruct_pop_field (SLang_Struct_Type *s, SLFUTURE_CONST char *name, int do_free); -extern int _pSLang_get_qualifiers_intrin (SLang_Struct_Type **); +extern int _pSLang_get_qualifiers_intrin (SLang_Struct_Type **); /* Value is not to be freed by caller */ + +extern int _pSLang_get_qualifiers (SLang_Struct_Type **); /* Caller must free when done */ +extern int _pSLang_set_qualifiers (SLang_Struct_Type *); struct _pSLang_Ref_Type { @@ -562,8 +565,6 @@ extern char *_pSLstringize_object (SLang_Object_Type *); extern int _pSLdump_objects (char *, SLang_Object_Type *, unsigned int, int); -extern SLang_Object_Type *_pSLang_get_run_stack_pointer (void); -extern SLang_Object_Type *_pSLang_get_run_stack_base (void); extern int _pSLang_dump_stack (void); extern int _pSLang_peek_at_stack2 (SLtype *); extern int _pSLang_restart_arg_list (int nargs); @@ -638,6 +639,8 @@ extern int _pSLcall_bof_handler (SLFUTURE_CONST char *, SLFUTURE_CONST char *); extern int _pSLcall_eof_handler (void); extern int _pSLcall_debug_hook (SLFUTURE_CONST char *file, int linenum); +extern int _pSLcall_bos_compile_hook (const char *file, long linenum); +extern int _pSLcall_bof_compile_hook (const char *file, const char *func); /* extern int _pSLcall_debug_hook (char *file, int linenum, char *funct); */ #endif @@ -903,8 +906,8 @@ extern SLclass_Type _pSLang_get_class_type (SLtype); extern void _pSLang_set_class_info (SLtype, SLang_Class_Type *); extern int _pSLarray_bin_op (SLang_Object_Type *, SLang_Object_Type *, int); -extern int _pSLarray1d_push_elem (SLang_Array_Type *at, SLindex_Type idx); #endif +extern int _pSLarray1d_push_elem (SLang_Array_Type *at, SLindex_Type idx); extern int _pSLarith_bin_op (SLang_Object_Type *, SLang_Object_Type *, int); /* Does not perform any range checking. It is up to the caller.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/config.hin -> _service:tar_scm:slang-2.3.3.tar.bz2/src/config.hin
Changed
@@ -188,6 +188,7 @@ #undef HAVE_SYS_UTSNAME_H #undef HAVE_UNAME +#undef HAVE_FLOCK #undef HAVE_ALARM #undef HAVE_PAUSE
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/pcconf.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/pcconf.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/sl-feat.h -> _service:tar_scm:slang-2.3.3.tar.bz2/src/sl-feat.h
Changed
@@ -10,10 +10,9 @@ #define SLANG_HAS_ASSOC_ARRAYS 1 #define SLANG_HAS_COMPLEX 1 -#define SLANG_HAS_FLOAT 1 /* This is the old space-speed trade off. To reduce memory usage and code - * size, set this to zero. + * size, set this to zero at the risk of resulting in slower running code. */ #define SLANG_OPTIMIZE_FOR_SPEED 2 @@ -89,3 +88,7 @@ #else # define SLANG_HAS_MULTILINE_RLINE 0 #endif + +/* The interpreter is crippled without floating point. Make it manditory. */ +#undef SLANG_HAS_FLOAT +#define SLANG_HAS_FLOAT 1
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slagetput.inc -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slagetput.inc
Changed
@@ -1,4 +1,6 @@ /* -*- mode: C -*- */ + + #ifdef AGET_FROM_INDEX_ARRAY_FUN static int AGET_FROM_INDEX_ARRAY_FUN (GENERIC_TYPE *src_data, SLindex_Type num_elements, SLang_Array_Type *ind_at, int is_range, @@ -11,13 +13,15 @@ SLarray_Range_Array_Type *r = (SLarray_Range_Array_Type *)ind_at->data; SLindex_Type idx = r->first_index, delta = r->delta; SLindex_Type j, jmax = (SLindex_Type) ind_at->num_elements; + int ispos; if (jmax == 0) return 0; - if ((idx >= 0) - && ((idx + delta * (jmax-1)) >= 0) - && ((idx + delta * (jmax-1)) < num_elements)) + if (-1 == check_range_indices (idx, delta, jmax, num_elements, &ispos)) + return -1; + + if (ispos) { for (j = 0; j < jmax; j++) { @@ -30,17 +34,7 @@ for (j = 0; j < jmax; j++) { SLindex_Type i = idx; - if (i < 0) - { - i += num_elements; - if (i < 0) - i = num_elements; - } - if (i >= num_elements) - { - SLang_set_error (SL_Index_Error); - return -1; - } + if (i < 0) i += num_elements; dest_dataj = src_datai; idx += delta; } @@ -55,17 +49,7 @@ { SLindex_Type i = *indices; - if (i < 0) - { - i += num_elements; - if (i < 0) - i = num_elements; - } - if (i >= num_elements) - { - SLang_set_error (SL_Index_Error); - return -1; - } + CHECK_INDEX(i,num_elements,return -1); *dest_data++ = src_datai; indices++; } @@ -86,13 +70,15 @@ SLarray_Range_Array_Type *r = (SLarray_Range_Array_Type *)ind_at->data; SLindex_Type idx = r->first_index, delta = r->delta; SLindex_Type j, jmax = (SLindex_Type) ind_at->num_elements; + int ispos; if (jmax == 0) return 0; - if ((idx >= 0) - && ((idx + delta * (jmax-1)) >= 0) - && ((idx + delta * (jmax-1)) < num_elements)) + if (-1 == check_range_indices (idx, delta, jmax, num_elements, &ispos)) + return -1; + + if (ispos) { for (j = 0; j < jmax; j++) { @@ -106,17 +92,7 @@ for (j = 0; j < jmax; j++) { SLindex_Type i = idx; - if (i < 0) - { - i += num_elements; - if (i < 0) - i = num_elements; - } - if (i >= num_elements) - { - SLang_set_error (SL_Index_Error); - return -1; - } + if (i < 0) i += num_elements; dest_datai = *(GENERIC_TYPE *)src_data; idx += delta; src_data += data_increment; @@ -132,17 +108,7 @@ { SLindex_Type i = *indices; - if (i < 0) - { - i += num_elements; - if (i < 0) - i = num_elements; - } - if (i >= num_elements) - { - SLang_set_error (SL_Index_Error); - return -1; - } + CHECK_INDEX(i,num_elements,return -1); dest_datai = *(GENERIC_TYPE *)src_data; src_data += data_increment; indices++;
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slang.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slang.c
Changed
@@ -1,7 +1,7 @@ /* -*- mode: C; mode: fold; -*- */ /* slang.c --- guts of S-Lang interpreter */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -169,7 +169,6 @@ int SLang_Num_Function_Args = 0; static int *Num_Args_Stack; static unsigned int Recursion_Depth; -static SLang_Object_Type *Frame_Pointer; static int Next_Function_Num_Args; static unsigned int Frame_Pointer_Depth; @@ -222,9 +221,10 @@ static int Lang_Return = 0; /* static int Lang_Continue = 0; */ -static SLang_Object_Type *Run_Stack; -static SLang_Object_Type *Stack_Pointer; -static SLang_Object_Type *Stack_Pointer_Max; +static SLang_Object_Type *Run_Stack = NULL; +static SLang_Object_Type *Run_Stack_Stack_Pointer = NULL; +static SLang_Object_Type *Run_Stack_Stack_Pointer_Max = NULL; +static SLang_Object_Type *Run_Stack_Frame_Pointer = NULL; static SLang_Object_Type *Local_Variable_Stack; static SLang_Object_Type *Local_Variable_Stack_Max; @@ -302,7 +302,7 @@ { register SLang_Object_Type *y; - y = Stack_Pointer; + y = Run_Stack_Stack_Pointer; IF_UNLIKELY(y == Run_Stack) { (void) SLang_set_error (SL_STACK_UNDERFLOW); @@ -312,7 +312,7 @@ y--; *x = *y; - Stack_Pointer = y; + Run_Stack_Stack_Pointer = y; return 0; } @@ -326,7 +326,7 @@ { register SLang_Object_Type *y; - y = Stack_Pointer; + y = Run_Stack_Stack_Pointer; if (Run_Stack + 2 > y) { @@ -338,7 +338,7 @@ } *b = *(--y); *a = *(--y); - Stack_Pointer = y; + Run_Stack_Stack_Pointer = y; return 0; } #endif @@ -353,7 +353,7 @@ register SLang_Object_Type *y; unsigned int i; - y = Stack_Pointer; + y = Run_Stack_Stack_Pointer; if (Run_Stack + n > y) { @@ -369,20 +369,20 @@ y--; xi = *y; } - Stack_Pointer = y; + Run_Stack_Stack_Pointer = y; return 0; } _INLINE_ static int peek_at_stack (void) { - IF_UNLIKELY(Stack_Pointer == Run_Stack) + IF_UNLIKELY(Run_Stack_Stack_Pointer == Run_Stack) { (void) SLang_set_error (SL_STACK_UNDERFLOW); return -1; } - return (int) (Stack_Pointer - 1)->o_data_type; + return (int) (Run_Stack_Stack_Pointer - 1)->o_data_type; } int SLang_peek_at_stack (void) @@ -393,15 +393,15 @@ int _pSLang_peek_at_stack2 (SLtype *_typep) { SLtype type; - if (Stack_Pointer == Run_Stack) + if (Run_Stack_Stack_Pointer == Run_Stack) { (void) SLang_set_error (SL_STACK_UNDERFLOW); return -1; } - type = (Stack_Pointer - 1)->o_data_type; + type = (Run_Stack_Stack_Pointer - 1)->o_data_type; if (type == SLANG_ARRAY_TYPE) - *_typep = (Stack_Pointer - 1)->v.array_val->data_type; + *_typep = (Run_Stack_Stack_Pointer - 1)->v.array_val->data_type; else *_typep = type; return (int) type; @@ -409,14 +409,14 @@ int SLang_peek_at_stack_n (unsigned int n) { - unsigned int stklen = (unsigned int)(Stack_Pointer - Run_Stack); + unsigned int stklen = (unsigned int)(Run_Stack_Stack_Pointer - Run_Stack); - if (n >= stklen) + IF_UNLIKELY(n >= stklen) { (void) SLang_set_error (SL_STACK_UNDERFLOW); return -1; } - return (int) (Stack_Pointer - (n+1))->o_data_type; + return (int) (Run_Stack_Stack_Pointer - (n+1))->o_data_type; } static int pop_ctrl_integer (int *i) @@ -429,7 +429,7 @@ /* Most of the time, either an integer or a char will be on the stack. * Optimize these cases. */ - y = Stack_Pointer; + y = Run_Stack_Stack_Pointer; IF_UNLIKELY(y == Run_Stack) { (void) SLang_set_error (SL_STACK_UNDERFLOW); @@ -440,13 +440,13 @@ type = (int) y->o_data_type; if (type == SLANG_INT_TYPE) { - Stack_Pointer = y; + Run_Stack_Stack_Pointer = y; *i = y->v.int_val; return 0; } if (type == SLANG_CHAR_TYPE) { - Stack_Pointer = y; + Run_Stack_Stack_Pointer = y; *i = y->v.char_val; return 0; } @@ -472,7 +472,7 @@ type = SLang_peek_at_stack_n (n); if (type == SLANG_ARRAY_TYPE) - type = (Stack_Pointer - (n+1))->v.array_val->data_type; + type = (Run_Stack_Stack_Pointer - (n+1))->v.array_val->data_type; return type; } @@ -510,24 +510,60 @@ free_object (obj, cl); } +static int increase_stack_size (int min_amount) +{ + SLang_Object_Type *new_stack; + size_t stack_size, new_stack_size, stack_depth, frame_pointer_offset; + + stack_depth = Run_Stack_Stack_Pointer - Run_Stack; + stack_size = Run_Stack_Stack_Pointer_Max - Run_Stack; + new_stack_size = stack_size + min_amount; + frame_pointer_offset = Run_Stack_Frame_Pointer - Run_Stack; + + if (new_stack_size > SLANG_MAX_STACK_LEN) + { + SLang_verror (SL_STACK_OVERFLOW, "Maximum stack size exceeded"); + return -1; + } + if (min_amount < SLANG_INITIAL_STACK_LEN) + { + new_stack_size = stack_size + SLANG_INITIAL_STACK_LEN; + if (new_stack_size > SLANG_MAX_STACK_LEN) + new_stack_size = SLANG_MAX_STACK_LEN; + } + + if (NULL == (new_stack = (SLang_Object_Type *)_SLrecalloc ((SLFUTURE_VOID *)Run_Stack, new_stack_size, sizeof(SLang_Object_Type)))) + return -1; + + memset (new_stack + stack_size, 0, (new_stack_size-stack_size)*sizeof(SLang_Object_Type)); + Run_Stack = new_stack; + Run_Stack_Stack_Pointer = new_stack + stack_depth; + Run_Stack_Stack_Pointer_Max = new_stack + new_stack_size; + + Run_Stack_Frame_Pointer = Run_Stack + frame_pointer_offset; + + return 0; +} + _INLINE_ static int push_object (SLang_Object_Type *x) { register SLang_Object_Type *y; - y = Stack_Pointer; + y = Run_Stack_Stack_Pointer; /* if there is a SLang_Error, probably not much harm will be done if it is ignored here */ /* if (SLang_Error) return; */ /* flag it now */ - IF_UNLIKELY(y >= Stack_Pointer_Max) + IF_UNLIKELY(y >= Run_Stack_Stack_Pointer_Max) { - (void) SLang_set_error (SL_STACK_OVERFLOW); - return -1; + if (-1 == increase_stack_size (1)) + return -1; + y = Run_Stack_Stack_Pointer; } *y = *x; - Stack_Pointer = y + 1; + Run_Stack_Stack_Pointer = y + 1; return 0; } @@ -540,36 +576,38 @@ int SLclass_push_ptr_obj (SLtype type, VOID_STAR pval) { register SLang_Object_Type *y; - y = Stack_Pointer; + y = Run_Stack_Stack_Pointer; - IF_UNLIKELY(y >= Stack_Pointer_Max) + IF_UNLIKELY(y >= Run_Stack_Stack_Pointer_Max) { - (void) SLang_set_error (SL_STACK_OVERFLOW); - return -1; + if (-1 == increase_stack_size (1)) + return -1; + y = Run_Stack_Stack_Pointer; } y->o_data_type = type; y->v.ptr_val = pval; - Stack_Pointer = y + 1; + Run_Stack_Stack_Pointer = y + 1; return 0; } _INLINE_ static int push_int_object (SLtype type, int x) { register SLang_Object_Type *y; - y = Stack_Pointer; + y = Run_Stack_Stack_Pointer; - IF_UNLIKELY(y >= Stack_Pointer_Max) + IF_UNLIKELY(y >= Run_Stack_Stack_Pointer_Max) { - (void) SLang_set_error (SL_STACK_OVERFLOW); - return -1; + if (-1 == increase_stack_size (1)) + return -1; + y = Run_Stack_Stack_Pointer; } y->o_data_type = type; y->v.int_val = x; - Stack_Pointer = y + 1; + Run_Stack_Stack_Pointer = y + 1; return 0; } @@ -579,18 +617,20 @@ _INLINE_ static int push_array_index (SLtype type, SLindex_Type x) { register SLang_Object_Type *y; - y = Stack_Pointer; + y = Run_Stack_Stack_Pointer; - IF_UNLIKELY(y >= Stack_Pointer_Max) + IF_UNLIKELY(y >= Run_Stack_Stack_Pointer_Max) { - (void) SLang_set_error (SL_STACK_OVERFLOW); - return -1; + if (-1 == increase_stack_size (1)) + return -1; + + y = Run_Stack_Stack_Pointer; } y->o_data_type = type; y->v.index_val = x; - Stack_Pointer = y + 1; + Run_Stack_Stack_Pointer = y + 1; return 0; } #endif @@ -604,20 +644,23 @@ { register SLang_Object_Type *y; - y = Stack_Pointer; + y = Run_Stack_Stack_Pointer; - IF_UNLIKELY(y >= Stack_Pointer_Max) + IF_UNLIKELY(y >= Run_Stack_Stack_Pointer_Max) { - (void) SLang_set_error (SL_STACK_OVERFLOW); - if (free_array) SLang_free_array (at); - return -1; + if (-1 == increase_stack_size (1)) + { + if (free_array) SLang_free_array (at); + return -1; + } + y = Run_Stack_Stack_Pointer; } if (free_array == 0) at->num_refs++; y->o_data_type = SLANG_ARRAY_TYPE; y->v.ptr_val = (VOID_STAR)at; - Stack_Pointer = y + 1; + Run_Stack_Stack_Pointer = y + 1; return 0; } @@ -625,18 +668,20 @@ _INLINE_ static int push_double_object (SLtype type, double x) { register SLang_Object_Type *y; - y = Stack_Pointer; + y = Run_Stack_Stack_Pointer; - IF_UNLIKELY(y >= Stack_Pointer_Max) + IF_UNLIKELY(y >= Run_Stack_Stack_Pointer_Max) { - (void) SLang_set_error (SL_STACK_OVERFLOW); - return -1; + if (-1 == increase_stack_size (1)) + return -1; + + y = Run_Stack_Stack_Pointer; } y->o_data_type = type; y->v.double_val = x; - Stack_Pointer = y + 1; + Run_Stack_Stack_Pointer = y + 1; return 0; } @@ -649,18 +694,20 @@ _INLINE_ static int push_char_object (SLtype type, char x) { register SLang_Object_Type *y; - y = Stack_Pointer; + y = Run_Stack_Stack_Pointer; - IF_UNLIKELY(y >= Stack_Pointer_Max) + IF_UNLIKELY(y >= Run_Stack_Stack_Pointer_Max) { - (void) SLang_set_error (SL_STACK_OVERFLOW); - return -1; + if (-1 == increase_stack_size (1)) + return -1; + + y = Run_Stack_Stack_Pointer; } y->o_data_type = type; y->v.char_val = x; - Stack_Pointer = y + 1; + Run_Stack_Stack_Pointer = y + 1; return 0; } @@ -672,6 +719,8 @@ /* This function is "fragile". It is a helper routine and assumes that y is on the stack */ static int _typecast_object_to_type (SLang_Object_Type *y, SLang_Object_Type *obj, SLtype type, int allow_arrays) { + size_t ofs = y - Run_Stack; + #if SLANG_OPTIMIZE_FOR_SPEED /* This is an implicit typecast. We do not want to typecast * floats to ints implicitly. @@ -695,8 +744,10 @@ return -1; } - /* Here, *y has been replaced by the object of the specified type */ - *obj = *y; + /* Here, *y has been replaced by the object of the specified type. But don't reference + * it directly in case the stack has been reallocated by the typecast function. + */ + *obj = Run_Stackofs; return 0; } @@ -706,23 +757,24 @@ SLang_Object_Type *y; SLang_Object_Type obj; - y = Stack_Pointer; + y = Run_Stack_Stack_Pointer; IF_UNLIKELY(y == Run_Stack) return SLang_pop(&obj); /* let it fail */ y--; if (y->o_data_type == SLANG_INT_TYPE) { *i = y->v.int_val; - Stack_Pointer = y; + Run_Stack_Stack_Pointer = y; return 0; } if (-1 == _typecast_object_to_type (y, &obj, SLANG_INT_TYPE, 0)) - { - /* Stack_Pointer = y; */ - return -1; - } + return -1; + *i = obj.v.int_val; - Stack_Pointer = y; + /* After the typecast function, y may nolonger point to a valid stack since + * it may have been reallocated. + */ + Run_Stack_Stack_Pointer--; return 0; } @@ -736,23 +788,21 @@ SLang_Object_Type *y; SLang_Object_Type obj; - y = Stack_Pointer; + y = Run_Stack_Stack_Pointer; if (y == Run_Stack) return SLang_pop (&obj); /* let it fail */ y--; if (y->o_data_type == SLANG_ARRAY_INDEX_TYPE) { *i = y->v.index_val; - Stack_Pointer = y; + Run_Stack_Stack_Pointer = y; return 0; } if (-1 == _typecast_object_to_type (y, &obj, SLANG_ARRAY_INDEX_TYPE, 0)) - { - /* Stack_Pointer = y; */ - return -1; - } + return -1; + *i = obj.v.index_val; - Stack_Pointer = y; + Run_Stack_Stack_Pointer--; /* do not use y here since the stack may have been reallocated */ return 0; } @@ -766,22 +816,20 @@ { register SLang_Object_Type *y; - y = Stack_Pointer; + y = Run_Stack_Stack_Pointer; IF_UNLIKELY(y == Run_Stack) return SLang_pop(obj); /* let it fail */ y--; if (y->o_data_type == type) { *obj = *y; - Stack_Pointer = y; + Run_Stack_Stack_Pointer = y; return 0; } if (-1 == _typecast_object_to_type (y, obj, type, allow_arrays)) - { - /* Stack_Pointer = y; */ - return -1; - } - Stack_Pointer = y; + return -1; + + Run_Stack_Stack_Pointer--; /* do not use y here since the stack may have been reallocated */ return 0; } @@ -811,7 +859,7 @@ { SLang_Object_Type *otop, *obot, tmp; - otop = Stack_Pointer; + otop = Run_Stack_Stack_Pointer; if ((n > otop - Run_Stack) || (n < 0)) { (void) SLang_set_error (SL_STACK_UNDERFLOW); @@ -827,7 +875,7 @@ otop--; obot++; } - return (int) ((Stack_Pointer - n) - Run_Stack); + return (int) ((Run_Stack_Stack_Pointer - n) - Run_Stack); } /* _INLINE_ */ @@ -838,7 +886,7 @@ if ((n = abs(np)) <= 1) return 0; /* identity */ - obot = otop = Stack_Pointer; + obot = otop = Run_Stack_Stack_Pointer; i = n; while (i != 0) { @@ -886,15 +934,15 @@ { SLang_Object_Type *ap, *bp; SLang_Object_Type tmp; - unsigned int stklen = (unsigned int)(Stack_Pointer - Run_Stack); + unsigned int stklen = (unsigned int)(Run_Stack_Stack_Pointer - Run_Stack); if ((a >= stklen) || (b >= stklen)) { (void) SLang_set_error (SL_STACK_UNDERFLOW); return -1; } - ap = Stack_Pointer - (a+1); - bp = Stack_Pointer - (b+1); + ap = Run_Stack_Stack_Pointer - (a+1); + bp = Run_Stack_Stack_Pointer - (b+1); tmp = *ap; *ap = *bp; @@ -905,45 +953,47 @@ int SLstack_depth (void) { - return (int) (Stack_Pointer - Run_Stack); + return (int) (Run_Stack_Stack_Pointer - Run_Stack); } int SLdup_n (int n) { - SLang_Object_Type *bot, *top; + int itop, ibot; if (n <= 0) return 0; - top = Stack_Pointer; - if (top < Run_Stack + n) + itop = Run_Stack_Stack_Pointer - Run_Stack; + if (itop < n) { (void) SLang_set_error (SL_STACK_UNDERFLOW); return -1; } - if (top + n > Stack_Pointer_Max) + if (Run_Stack_Stack_Pointer + n >= Run_Stack_Stack_Pointer_Max) { - (void) SLang_set_error (SL_STACK_OVERFLOW); - return -1; + if (-1 == increase_stack_size (n)) + return -1; } - bot = top - n; + ibot = itop - n; - while (bot < top) + while (ibot < itop) { SLang_Class_Type *cl; + SLang_Object_Type *bot = Run_Stack + ibot; SLtype data_type = bot->o_data_type; #if SLANG_OPTIMIZE_FOR_SPEED if (SLANG_CLASS_TYPE_SCALAR == GET_CLASS_TYPE(data_type)) { - *Stack_Pointer++ = *bot++; + *Run_Stack_Stack_Pointer++ = *bot; + ibot++; continue; } #endif GET_CLASS(cl,data_type); if (-1 == (*cl->cl_push) (data_type, (VOID_STAR) &bot->v)) return -1; - bot++; + ibot++; } return 0; } @@ -1091,7 +1141,25 @@ return SLang_pop_struct (&Next_Function_Qualifiers); } -/* This function is called from slang code */ +int _pSLang_set_qualifiers (SLang_Struct_Type *q) +{ + /* For efficiency, skip the push_struct/set_qualifier step */ + if (Next_Function_Qualifiers != NULL) + SLang_free_struct (Next_Function_Qualifiers); + if (q != NULL) q->num_refs++; + Next_Function_Qualifiers = q; + return 0; +} + +int _pSLang_get_qualifiers (SLang_Struct_Type **qp) +{ + SLang_Struct_Type *q = Function_Qualifiers; + if (q != NULL) q->num_refs++; + *qp = q; + return 0; +} + +/* This function is called from slang code by the __qualifiers function */ int _pSLang_get_qualifiers_intrin (SLang_Struct_Type **qp) { /* The assumption is that this is being called from a function one level up. @@ -1257,8 +1325,8 @@ { IF_LIKELY(Frame_Pointer_Depth < SLANG_MAX_RECURSIVE_DEPTH) { - Frame_Pointer_Stack Frame_Pointer_Depth = (unsigned int) (Frame_Pointer - Run_Stack); - Frame_Pointer = Stack_Pointer; + Frame_Pointer_Stack Frame_Pointer_Depth = (unsigned int) (Run_Stack_Frame_Pointer - Run_Stack); + Run_Stack_Frame_Pointer = Run_Stack_Stack_Pointer; Frame_Pointer_Depth++; Next_Function_Num_Args = 0; return 0; @@ -1277,13 +1345,13 @@ { if (Frame_Pointer_Depth < SLANG_MAX_RECURSIVE_DEPTH) { - if ((nargs < 0) || (Run_Stack + nargs > Stack_Pointer)) + if ((nargs < 0) || (Run_Stack + nargs > Run_Stack_Stack_Pointer)) { _pSLang_verror (SL_Internal_Error, "restart_arg_list: stack underflow"); return -1; } - Frame_Pointer_Stack Frame_Pointer_Depth = (unsigned int) (Frame_Pointer - Run_Stack); - Frame_Pointer = Stack_Pointer - nargs; + Frame_Pointer_Stack Frame_Pointer_Depth = (unsigned int) (Run_Stack_Frame_Pointer - Run_Stack); + Run_Stack_Frame_Pointer = Run_Stack_Stack_Pointer - nargs; Frame_Pointer_Depth++; Next_Function_Num_Args = 0; return 0; @@ -1303,8 +1371,8 @@ Frame_Pointer_Depth--; if (Frame_Pointer_Depth < SLANG_MAX_RECURSIVE_DEPTH) { - Next_Function_Num_Args = (int) (Stack_Pointer - Frame_Pointer); - Frame_Pointer = Run_Stack + Frame_Pointer_Stack Frame_Pointer_Depth; + Next_Function_Num_Args = (int) (Run_Stack_Stack_Pointer - Run_Stack_Frame_Pointer); + Run_Stack_Frame_Pointer = Run_Stack + Frame_Pointer_Stack Frame_Pointer_Depth; } return 0; } @@ -1481,7 +1549,10 @@ SLang_set_error (SL_DIVIDE_ERROR); return -1; } - objc->v.int_val = a/b; objc->o_data_type = SLANG_INT_TYPE; + if (b == -1) objc->v.int_val = -a; + else + objc->v.int_val = a/b; + objc->o_data_type = SLANG_INT_TYPE; return 0; case SLANG_MOD: if (b == 0) @@ -1489,7 +1560,10 @@ SLang_set_error (SL_DIVIDE_ERROR); return -1; } - objc->v.int_val = a % b; objc->o_data_type = SLANG_INT_TYPE; + if (b == -1) objc->v.int_val = 0; + else + objc->v.int_val = a % b; + objc->o_data_type = SLANG_INT_TYPE; return 0; case SLANG_BAND: @@ -1552,6 +1626,7 @@ SLang_set_error (SL_DIVIDE_ERROR); return -1; } + else if (b == -1) return push_int_object (SLANG_INT_TYPE, -a); return push_int_object (SLANG_INT_TYPE, a/b); case SLANG_MOD: if (b == 0) @@ -1559,6 +1634,7 @@ SLang_set_error (SL_DIVIDE_ERROR); return -1; } + if (b == -1) return push_int_object (SLANG_INT_TYPE, 0); return push_int_object (SLANG_INT_TYPE, a%b); case SLANG_BAND: @@ -1810,6 +1886,7 @@ SLang_set_error (SL_DIVIDE_ERROR); return -1; } + if (b == -1) return push_int_object (SLANG_INT_TYPE, -a); return push_int_object (SLANG_INT_TYPE, a/b); case SLANG_MOD: if (b == 0) @@ -1817,6 +1894,7 @@ SLang_set_error (SL_DIVIDE_ERROR); return -1; } + if (b == -1) return push_int_object (SLANG_INT_TYPE, 0); return push_int_object (SLANG_INT_TYPE, a%b); case SLANG_BAND: @@ -2030,7 +2108,7 @@ #endif int ret; - objbp = Stack_Pointer; + objbp = Run_Stack_Stack_Pointer; if (Run_Stack + 2 > objbp) { (void) SLang_set_error (SL_STACK_UNDERFLOW); @@ -2040,7 +2118,7 @@ objbp--; objap = objbp-1; - Stack_Pointer = objap; + Run_Stack_Stack_Pointer = objap; #if SLANG_OPTIMIZE_FOR_SPEED if (objbp->o_data_type == objap->o_data_type) { @@ -2125,12 +2203,12 @@ if (btype == SLANG_INT_TYPE) { - if (Stack_Pointer == Run_Stack) + if (Run_Stack_Stack_Pointer == Run_Stack) { (void) SLang_set_error (SL_STACK_UNDERFLOW); return; } - objap = (Stack_Pointer-1); + objap = (Run_Stack_Stack_Pointer-1); atype = objap->o_data_type; if (atype == SLANG_INT_TYPE) @@ -2206,12 +2284,12 @@ { double a, b; - if (Stack_Pointer == Run_Stack) + if (Run_Stack_Stack_Pointer == Run_Stack) { (void) SLang_set_error (SL_STACK_UNDERFLOW); return; } - objap = (Stack_Pointer-1); + objap = (Run_Stack_Stack_Pointer-1); atype = objap->o_data_type; if (atype == SLANG_DOUBLE_TYPE) @@ -2728,6 +2806,7 @@ case SLANG_COMPLEX_TYPE: u->o_data_type = SLANG_DOUBLE_TYPE; + /* fall through */ case SLANG_DOUBLE_TYPE: u->v.double_val = 1; break; @@ -3494,12 +3573,12 @@ SLtype ret_type; unsigned int argc; unsigned int i; - FVOID_STAR fptr; + SLFvoid_Star fptr; SLtype *arg_types; int stk_depth; int num_args; - fptr = objf->i_fun; + fptr = (SLFvoid_Star)objf->i_fun; argc = objf->num_args; ret_type = objf->return_type; arg_types = objf->arg_types; @@ -3531,7 +3610,7 @@ if (stk_depth >= 0) trace_dump (">>%s (%d args)\n", (char *) objf->name, - Stack_Pointer - nargs, + Run_Stack_Stack_Pointer - nargs, nargs, 1); } @@ -3669,7 +3748,7 @@ trace_dump ("<<%s (returning %d values)\n", (char *) objf->name, - Stack_Pointer - stk_depth, + Run_Stack_Stack_Pointer - stk_depth, stk_depth, 1); } @@ -3741,7 +3820,7 @@ case SLANG_BCST_FOREACH_EARGS: if (-1 == end_arg_list ()) goto return_error; - /* drop */ + /* fall through */ case SLANG_BCST_FOREACH: /* obsolete */ loop_name = "foreach"; if (num_blocks != 1) @@ -3997,7 +4076,7 @@ wrong_num_blocks_error: _pSLang_verror (SL_SYNTAX_ERROR, "Wrong number of blocks for '%s' construct", loop_name); - /* drop */ + /* fall through */ return_error: return -1; /* do_traceback (loop_name, NULL, -1); */ @@ -4283,7 +4362,7 @@ } } ret = 0; - /* drop */ + /* fall through */ return_error: if (cp != NULL) SLang_free_object (cp); @@ -4579,7 +4658,7 @@ stack_depth = SLstack_depth () - stack_depth; trace_dump ("<<%s (returning %d values)\n", (char *) fun->name, - Stack_Pointer - stack_depth, + Run_Stack_Stack_Pointer - stack_depth, stack_depth, 1); @@ -4766,6 +4845,11 @@ SLtype subtype; subtype = obj->o_data_type; + IF_UNLIKELY (subtype == 0) + { + SLang_set_error (SL_VariableUninitialized_Error); + return -1; + } GET_CLASS(cl,subtype); @@ -4783,11 +4867,11 @@ int _pSLslang_copy_obj (SLang_Object_Type *obja, SLang_Object_Type *objb) { +#if SLANG_OPTIMIZE_FOR_SPEED SLtype type; type = obja->o_data_type; -#if SLANG_OPTIMIZE_FOR_SPEED if (SLANG_CLASS_TYPE_SCALAR == GET_CLASS_TYPE(type)) { *objb = *obja; @@ -5278,7 +5362,7 @@ } status = _pSLstrops_do_sprintf_n (argc-1); - /* drop */ + /* fall through */ free_return: for (i = 0; i < argc; i++) @@ -5886,7 +5970,7 @@ break; } } - /* drop */ + /* fall through */ case SLANG_BCST_ANDELSE: if (block == NULL) block = addr; lang_do_and_orelse (0, block, addr); @@ -5904,7 +5988,7 @@ break; } } - /* drop */ + /* fall through */ case SLANG_BCST_ORELSE: if (block == NULL) block = addr; lang_do_and_orelse (1, block, addr); @@ -6067,7 +6151,7 @@ case SLANG_BC_CALL_DIRECT_RETINTR: (*addr->b.call_function) (); addr++; - /* drop */ + /* fall through */ case SLANG_BC_RET_INTRINSIC: EXECUTE_INTRINSIC (addr) if (0 == Handle_Interrupt) @@ -6355,7 +6439,7 @@ if (-1 == push_local_variable (addr->b.i_blk)) break; addr++; - /* drop */ + /* fall through */ case SLANG_BC_LVARIABLE_APUT1: { SLang_Object_Type *o; @@ -6547,7 +6631,7 @@ if (-1 == push_object (&obj3)) break; } - /* drop */ + /* fall through */ case SLANG_BC_IF_BLOCK: { int i; @@ -6861,7 +6945,7 @@ case SLANG_BC_COMBINED: if (0 == (p->bc_flags & BC_LITERAL_MASK)) break; - /* drop */ + /* fall through */ case SLANG_BC_LITERAL: case SLANG_BC_LITERAL_STR: case SLANG_BC_LITERAL_DBL: @@ -7103,7 +7187,7 @@ (void) _pSLerr_suspend_messages (); status = 0; - /* drop */ + /* fall through */ free_return: if (free_name) @@ -8497,6 +8581,12 @@ return -1; } Compile_ByteCode_Ptr = This_Compile_Block; + +#if SLANG_HAS_DEBUG_CODE && SLANG_HAS_BOSEOS + if (h->issue_bofeof_info + && (-1 == _pSLcall_bof_compile_hook (h->file, name))) + return -1; +#endif return 0; } @@ -8765,7 +8855,7 @@ /* The validity of this step needs to be reexamined in the context * of the new exception handling for slang 2 */ - while (Stack_Pointer != Run_Stack) + while (Run_Stack_Stack_Pointer != Run_Stack) { SLdo_pop (); } @@ -10131,7 +10221,8 @@ #endif case BOS_TOKEN: #if SLANG_HAS_DEBUG_CODE && SLANG_HAS_BOSEOS - compile_line_info (SLANG_BC_BOS, This_Compile_Filename, t->v.long_val); + if (0 == _pSLcall_bos_compile_hook (This_Compile_Filename, t->v.long_val)) + compile_line_info (SLANG_BC_BOS, This_Compile_Filename, t->v.long_val); #endif break; case EOS_TOKEN: @@ -10417,7 +10508,7 @@ if (Run_Stack != NULL) { /* Allow any object destructors to run */ - while (Stack_Pointer != Run_Stack) + while (Run_Stack_Stack_Pointer != Run_Stack) { SLdo_pop (); } @@ -10450,13 +10541,8 @@ return -1; Global_NameSpace = ns; - Run_Stack = (SLang_Object_Type *) SLcalloc (SLANG_MAX_STACK_LEN, - sizeof (SLang_Object_Type)); - if (Run_Stack == NULL) - goto return_error; - - Stack_Pointer = Run_Stack; - Stack_Pointer_Max = Run_Stack + SLANG_MAX_STACK_LEN; + if (-1 == increase_stack_size (SLANG_INITIAL_STACK_LEN)) + return -1; Num_Args_Stack = (int *) _SLcalloc (SLANG_MAX_RECURSIVE_DEPTH, sizeof(int)); if (Num_Args_Stack == NULL) @@ -10467,7 +10553,6 @@ if (Frame_Pointer_Stack == NULL) goto return_error; Frame_Pointer_Depth = 0; - Frame_Pointer = Run_Stack; Local_Variable_Stack = (SLang_Object_Type *) _SLcalloc (SLANG_MAX_LOCAL_STACK, sizeof(SLang_Object_Type)); if (Local_Variable_Stack == NULL) @@ -10925,22 +11010,12 @@ return Current_Function->name; } -SLang_Object_Type *_pSLang_get_run_stack_pointer (void) -{ - return Stack_Pointer; -} - -SLang_Object_Type *_pSLang_get_run_stack_base (void) -{ - return Run_Stack; -} - int _pSLang_dump_stack (void) /*{{{*/ { char buf32; unsigned int n; - n = (unsigned int) (Stack_Pointer - Run_Stack); + n = (unsigned int) (Run_Stack_Stack_Pointer - Run_Stack); while (n) { n--;
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slang.h -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slang.h
Changed
@@ -2,7 +2,7 @@ #define DAVIS_SLANG_H_ /* -*- mode: C; mode: fold; -*- */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -22,8 +22,8 @@ USA. */ -#define SLANG_VERSION 20302 -#define SLANG_VERSION_STRING "2.3.2" +#define SLANG_VERSION 20303 +#define SLANG_VERSION_STRING "2.3.3" /* #ifdef __DATE__ */ /* # define SLANG_VERSION_STRING SLANG_VERSION_STRING0 " " __DATE__ */ /* #else */ @@ -229,6 +229,7 @@ #endif typedef int (*FVOID_STAR)(void); +typedef void (*SLFvoid_Star)(void); #if defined(__MSDOS__) && defined(__BORLANDC__) # define SLFREE(buf) farfree((void far *)(buf)) @@ -1333,6 +1334,7 @@ /* This is an interface to atexit */ SL_EXTERN int SLang_add_cleanup_function (void (*)(void)); +/* The SLmake_nstring functions return malloced strings, and not slang hashed slstrings */ SL_EXTERN char *SLmake_string (SLFUTURE_CONST char *); SL_EXTERN char *SLmake_nstring (SLFUTURE_CONST char *, SLstrlen_Type); /* Returns a null terminated string made from the first n characters of the @@ -1505,7 +1507,7 @@ typedef struct SLKeymap_Function_Type { SLFUTURE_CONST char *name; - int (*f)(void); + FVOID_STAR f; } SLKeymap_Function_Type; @@ -2240,7 +2242,7 @@ SLtype from_type, SLtype to_type); #define MAKE_INTRINSIC_N(n,f,out,in,a1,a2,a3,a4,a5,a6,a7) \ - {(n), NULL, SLANG_INTRINSIC, (FVOID_STAR) (f), \ + {(n), NULL, SLANG_INTRINSIC, (FVOID_STAR)(SLFvoid_Star)(f), \ {a1,a2,a3,a4,a5,a6,a7}, (in), (out)} #define MAKE_INTRINSIC_7(n,f,out,a1,a2,a3,a4,a5,a6,a7) \
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slarith.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slarith.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -141,37 +141,20 @@ /* Here are a bunch of functions to convert from one type to another. To * facilitate the process, macros will be used. */ - -#define DEFUN_1(f,from_type,to_type) \ -static void f (to_type *y, from_type *x, SLuindex_Type n) \ -{ \ - SLuindex_Type i; \ - for (i = 0; i < n; i++) yi = (to_type) xi; \ -} - -#define DEFUN_2(f,from_type,to_type,copy_fun) \ -static VOID_STAR f (VOID_STAR xp, SLuindex_Type n) \ -{ \ - from_type *x; \ - to_type *y; \ - x = (from_type *) xp; \ - if (NULL == (y = (to_type *) _SLcalloc (n, sizeof (to_type)))) return NULL; \ - copy_fun (y, x, n); \ - return (VOID_STAR) y; \ -} typedef VOID_STAR (*Convert_Fun_Type)(VOID_STAR, SLuindex_Type); -#if SLANG_HAS_FLOAT -#define TO_DOUBLE_FUN(name,type) \ - static double name (VOID_STAR x) { return (double) *(type *) x; } +typedef int (*Bin_Fun_Type) (int, + SLtype, VOID_STAR, SLuindex_Type, + SLtype, VOID_STAR, SLuindex_Type, + VOID_STAR); +#if SLANG_HAS_FLOAT typedef SLCONST struct { unsigned int sizeof_type; double (*to_double_fun)(VOID_STAR); } To_Double_Fun_Table_Type; - #endif /* Each element of the matrix determines how the row maps onto the column. @@ -187,8 +170,9 @@ */ typedef struct { - FVOID_STAR copy_function; + SLFvoid_Star copy_function; Convert_Fun_Type convert_function; + Bin_Fun_Type bin_op_function; } Binary_Matrix_Type; @@ -212,228 +196,6 @@ } #endif /* SLANG_HAS_FLOAT */ -#define GENERIC_BINARY_FUNCTION int_int_bin_op -#define GENERIC_BIT_OPERATIONS -#define GENERIC_TYPE int -#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) -#define POW_RESULT_TYPE double -#define ABS_FUNCTION abs -#define MOD_FUNCTION(a,b) ((a) % (b)) -#define TRAP_DIV_ZERO 1 -#define GENERIC_UNARY_FUNCTION int_unary_op -#define GENERIC_ARITH_UNARY_FUNCTION int_arith_unary_op -#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0)) -#if SLANG_OPTIMIZE_FOR_SPEED -# define SCALAR_BINARY_FUNCTION int_int_scalar_bin_op -#endif -#define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_int_obj(SLANG_INT_TYPE,(x)) -#define PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x)) -#define CMP_FUNCTION int_cmp_function -#include "slarith.inc" - -#define GENERIC_BINARY_FUNCTION uint_uint_bin_op -#define GENERIC_BIT_OPERATIONS -#define GENERIC_TYPE unsigned int -#define GENERIC_TYPE_IS_UNSIGNED -#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) -#define POW_RESULT_TYPE double -#define MOD_FUNCTION(a,b) ((a) % (b)) -#define TRAP_DIV_ZERO 1 -#define GENERIC_UNARY_FUNCTION uint_unary_op -#define GENERIC_ARITH_UNARY_FUNCTION uint_arith_unary_op -#define ABS_FUNCTION(a) (a) -#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : 0) -#if SLANG_OPTIMIZE_FOR_SPEED -# define SCALAR_BINARY_FUNCTION uint_uint_scalar_bin_op -#endif -#define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_int_obj(SLANG_UINT_TYPE,(int)(x)) -#define PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x)) -#define CMP_FUNCTION uint_cmp_function -#define TO_BINARY_FUNCTION uint_to_binary -#include "slarith.inc" - -#if LONG_IS_NOT_INT -#define GENERIC_BINARY_FUNCTION long_long_bin_op -#define GENERIC_BIT_OPERATIONS -#define GENERIC_TYPE long -#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) -#define POW_RESULT_TYPE double -#define MOD_FUNCTION(a,b) ((a) % (b)) -#define TRAP_DIV_ZERO 1 -#define GENERIC_UNARY_FUNCTION long_unary_op -#define GENERIC_ARITH_UNARY_FUNCTION long_arith_unary_op -#define ABS_FUNCTION(a) (((a) >= 0) ? (a) : -(a)) -#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0)) -#if SLANG_OPTIMIZE_FOR_SPEED -# define SCALAR_BINARY_FUNCTION long_long_scalar_bin_op -#endif -#define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_long_obj(SLANG_LONG_TYPE,(x)) -#define PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x)) -#define CMP_FUNCTION long_cmp_function -#include "slarith.inc" - -#define GENERIC_BINARY_FUNCTION ulong_ulong_bin_op -#define GENERIC_BIT_OPERATIONS -#define GENERIC_TYPE unsigned long -#define GENERIC_TYPE_IS_UNSIGNED -#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) -#define POW_RESULT_TYPE double -#define MOD_FUNCTION(a,b) ((a) % (b)) -#define TRAP_DIV_ZERO 1 -#define GENERIC_UNARY_FUNCTION ulong_unary_op -#define GENERIC_ARITH_UNARY_FUNCTION ulong_arith_unary_op -#define ABS_FUNCTION(a) (a) -#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : 0) -#if SLANG_OPTIMIZE_FOR_SPEED -# define SCALAR_BINARY_FUNCTION ulong_ulong_scalar_bin_op -#endif -#define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_long_obj(SLANG_ULONG_TYPE,(long)(x)) -#define PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x)) -#define CMP_FUNCTION ulong_cmp_function -#define TO_BINARY_FUNCTION ulong_to_binary -#include "slarith.inc" -#else -#define long_long_bin_op int_int_bin_op -#define ulong_ulong_bin_op uint_uint_bin_op -#define long_unary_op int_unary_op -#define ulong_unary_op uint_unary_op -#define long_cmp_function int_cmp_function -#define ulong_cmp_function uint_cmp_function -#define ulong_to_binary uint_to_binary -#endif /* LONG_IS_NOT_INT */ - -#ifdef HAVE_LONG_LONG -# if LLONG_IS_NOT_LONG -# define GENERIC_BINARY_FUNCTION llong_llong_bin_op -# define GENERIC_BIT_OPERATIONS -# define GENERIC_TYPE long long -# define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) -# define POW_RESULT_TYPE double -# define MOD_FUNCTION(a,b) ((a) % (b)) -# define TRAP_DIV_ZERO 1 -# define GENERIC_UNARY_FUNCTION llong_unary_op -# define GENERIC_ARITH_UNARY_FUNCTION llong_arith_unary_op -# define ABS_FUNCTION(a) (((a) >= 0) ? (a) : -(a)) -# define SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0)) -# if SLANG_OPTIMIZE_FOR_SPEED -# define SCALAR_BINARY_FUNCTION llong_llong_scalar_bin_op -# endif -# define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_llong_obj(SLANG_LLONG_TYPE,(x)) -# define PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x)) -# define CMP_FUNCTION llong_cmp_function -# include "slarith.inc" - -# define GENERIC_BINARY_FUNCTION ullong_ullong_bin_op -# define GENERIC_BIT_OPERATIONS -# define GENERIC_TYPE unsigned long long -# define GENERIC_TYPE_IS_UNSIGNED -# define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) -# define POW_RESULT_TYPE double -# define MOD_FUNCTION(a,b) ((a) % (b)) -# define TRAP_DIV_ZERO 1 -# define GENERIC_UNARY_FUNCTION ullong_unary_op -# define GENERIC_ARITH_UNARY_FUNCTION ullong_arith_unary_op -# define ABS_FUNCTION(a) (a) -# define SIGN_FUNCTION(x) (((x) > 0) ? 1 : 0) -# if SLANG_OPTIMIZE_FOR_SPEED -# define SCALAR_BINARY_FUNCTION ullong_ullong_scalar_bin_op -# endif -# define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_llong_obj(SLANG_ULLONG_TYPE,(long long)(x)) -# define PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x)) -# define CMP_FUNCTION ullong_cmp_function -# define TO_BINARY_FUNCTION ullong_to_binary -# include "slarith.inc" -# else -# define llong_llong_bin_op long_long_bin_op -# define ullong_ullong_bin_op ulong_ulong_bin_op -# define llong_llong_scalar_bin_op long_long_scalar_bin_op -# define ullong_ullong_scalar_bin_op ulong_ulong_scalar_bin_op -# define ullong_to_binary ulong_to_binary -# endif /* LLONG_IS_NOT_LONG */ -#endif /* HAVE_LONG_LONG */ - -#if SLANG_HAS_FLOAT -#define GENERIC_BINARY_FUNCTION float_float_bin_op -#define GENERIC_TYPE float -#define POW_FUNCTION(a,b) (float)pow((double)(a),(double)(b)) -#define POW_RESULT_TYPE float -#define MOD_FUNCTION(a,b) (float)fmod((a),(b)) -#define TRAP_DIV_ZERO 0 -#define GENERIC_UNARY_FUNCTION float_unary_op -#define GENERIC_ARITH_UNARY_FUNCTION float_arith_unary_op -#define ABS_FUNCTION(a) (float)fabs((double) a) -#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0)) -#if SLANG_OPTIMIZE_FOR_SPEED -# define SCALAR_BINARY_FUNCTION float_float_scalar_bin_op -#endif -#define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_float_obj(SLANG_FLOAT_TYPE,(x)) -#define PUSH_POW_OBJ_FUN(x) SLclass_push_float_obj(SLANG_FLOAT_TYPE, (x)) -#define CMP_FUNCTION float_cmp_function -#include "slarith.inc" - -#define GENERIC_BINARY_FUNCTION double_double_bin_op -#define GENERIC_TYPE double -#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) -#define POW_RESULT_TYPE double -#define MOD_FUNCTION(a,b) fmod((a),(b)) -#define TRAP_DIV_ZERO 0 -#define GENERIC_UNARY_FUNCTION double_unary_op -#define GENERIC_ARITH_UNARY_FUNCTION double_arith_unary_op -#define ABS_FUNCTION(a) fabs(a) -#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0)) -#if SLANG_OPTIMIZE_FOR_SPEED -# define SCALAR_BINARY_FUNCTION double_double_scalar_bin_op -#endif -#define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE,(x)) -#define PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x)) -#define CMP_FUNCTION double_cmp_function -#include "slarith.inc" -#endif /* SLANG_HAS_FLOAT */ - -#define GENERIC_UNARY_FUNCTION char_unary_op -#define GENERIC_ARITH_UNARY_FUNCTION char_arith_unary_op -#define GENERIC_BINARY_FUNCTION char_char_arith_bin_op -#define JUST_BOOLEAN_BINARY_OPS -#define GENERIC_BIT_OPERATIONS -#define GENERIC_TYPE signed char -#define ABS_FUNCTION abs -#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0)) -#define CMP_FUNCTION char_cmp_function -#include "slarith.inc" - -#define GENERIC_UNARY_FUNCTION uchar_unary_op -#define GENERIC_ARITH_UNARY_FUNCTION uchar_arith_unary_op -#define GENERIC_BIT_OPERATIONS -#define GENERIC_TYPE unsigned char -#define GENERIC_TYPE_IS_UNSIGNED -#define ABS_FUNCTION(x) (x) -#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : 0) -#define CMP_FUNCTION uchar_cmp_function -#define TO_BINARY_FUNCTION uchar_to_binary -#include "slarith.inc" - -#if SHORT_IS_NOT_INT -#define GENERIC_UNARY_FUNCTION short_unary_op -#define GENERIC_ARITH_UNARY_FUNCTION short_arith_unary_op -#define GENERIC_BIT_OPERATIONS -#define GENERIC_TYPE short -#define ABS_FUNCTION abs -#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0)) -#define CMP_FUNCTION short_cmp_function -#include "slarith.inc" - -#define GENERIC_UNARY_FUNCTION ushort_unary_op -#define GENERIC_ARITH_UNARY_FUNCTION ushort_arith_unary_op -#define GENERIC_BIT_OPERATIONS -#define GENERIC_TYPE unsigned short -#define GENERIC_TYPE_IS_UNSIGNED -#define ABS_FUNCTION(x) (x) -#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : 0) -#define CMP_FUNCTION ushort_cmp_function -#define TO_BINARY_FUNCTION ushort_to_binary -#include "slarith.inc" -#endif /* SHORT_IS_NOT_INT */ - int _pSLarith_get_precedence (SLtype type) { if ((type < SLANG_CHAR_TYPE) || (type > MAX_SLARITH_TYPE)) @@ -466,7 +228,7 @@ t = SLANG_UINT_TYPE; break; #endif - /* drop */ + /* fall through */ case SLANG_CHAR_TYPE: case SLANG_UCHAR_TYPE: case SLANG_SHORT_TYPE: @@ -530,86 +292,89 @@ return 1; } -typedef int (*Bin_Fun_Type) (int, - SLtype, VOID_STAR, SLuindex_Type, - SLtype, VOID_STAR, SLuindex_Type, - VOID_STAR); - -/* This array of functions must be indexed by precedence after arithmetic - * promotions. +/* This function is used to compute the result of a binary operation between + * two arithmetic types. The resulting type depends upon the operation. Boolean + * operations produce Char_Type. The result of the other operations depends upon + * the C promotion rules. If the two operands promote to a C float, the pow + * operator will produce a float. Otherwise a double will result for the pow + * operation. Other operations produce the type given by the promotion rules. */ -static Bin_Fun_Type Bin_Fun_Map MAX_ARITHMETIC_TYPES = -{ - NULL, /* char */ - NULL, /* uchar */ - NULL, /* short */ - NULL, /* ushort */ - int_int_bin_op, /* int */ - uint_uint_bin_op, /* uint */ - long_long_bin_op, /* long */ - ulong_ulong_bin_op, /* ulong */ -#ifdef HAVE_LONG_LONG - llong_llong_bin_op, /* llong */ - ullong_ullong_bin_op, /* ullong */ -#else - NULL, NULL, -#endif - float_float_bin_op, /* float */ - double_double_bin_op /* double */ -}; - static int arith_bin_op (int op, SLtype a_type, VOID_STAR ap, SLuindex_Type na, SLtype b_type, VOID_STAR bp, SLuindex_Type nb, VOID_STAR cp) { Bin_Fun_Type binfun; - int c_indx; + VOID_STAR ap_c, bp_c; + int a_indx, b_indx, c_indx, ret; SLtype c_type; - if ((a_type == b_type) - && ((a_type == SLANG_CHAR_TYPE) || (a_type == SLANG_UCHAR_TYPE))) - { - switch (op) - { - case SLANG_EQ: - case SLANG_NE: - case SLANG_AND: - case SLANG_OR: - return char_char_arith_bin_op (op, a_type, ap, na, b_type, bp, nb, cp); - } - } + a_indx = TYPE_TO_TABLE_INDEX(a_type); + b_indx = TYPE_TO_TABLE_INDEX(b_type); + + binfun = Binary_Matrixa_indxb_indx.bin_op_function; + if (binfun != NULL) + return (*binfun) (op, a_type, ap, na, b_type, bp, nb, cp); c_type = promote_to_common_type (a_type, b_type); c_indx = TYPE_TO_TABLE_INDEX(c_type); - binfun = Bin_Fun_Mapc_indx; - if ((c_type != a_type) || (c_type != b_type)) + /* A convert_function will return its argument when converting + * between signed and unsigned versions of an integer. + */ + ap_c = ap; + bp_c = bp; + + /* Try to convert the one with fewer elements first */ + if ((na <= nb) && (a_type != c_type)) { - int ret; - int a_indx = TYPE_TO_TABLE_INDEX(a_type); - int b_indx = TYPE_TO_TABLE_INDEX(b_type); - Convert_Fun_Type af = Binary_Matrixa_indxc_indx.convert_function; - Convert_Fun_Type bf = Binary_Matrixb_indxc_indx.convert_function; - - if ((af != NULL) - && (NULL == (ap = (VOID_STAR) (*af) (ap, na)))) + Convert_Fun_Type f = Binary_Matrixa_indxc_indx.convert_function; + if ((f == NULL) + || (NULL == (ap_c = (VOID_STAR) (*f) (ap, na)))) return -1; + a_type = c_type; a_indx = c_indx; + binfun = Binary_Matrixa_indxb_indx.bin_op_function; + } - if ((bf != NULL) - && (NULL == (bp = (VOID_STAR) (*bf) (bp, nb)))) + if ((binfun == NULL) && (b_type != c_type)) + { + Convert_Fun_Type f = Binary_Matrixb_indxc_indx.convert_function; + if ((f == NULL) + || (NULL == (bp_c = (VOID_STAR) (*f) (bp, nb)))) { - if (af != NULL) SLfree ((char *) ap); + if (ap_c != ap) SLfree ((char *)ap_c); return -1; } + b_type = c_type; b_indx = c_indx; + binfun = Binary_Matrixa_indxb_indx.bin_op_function; + } - ret = (*binfun) (op, a_type, ap, na, b_type, bp, nb, cp); - if (af != NULL) SLfree ((char *) ap); - if (bf != NULL) SLfree ((char *) bp); - return ret; + if ((binfun == NULL) && (a_type != c_type)) + { + Convert_Fun_Type f = Binary_Matrixa_indxc_indx.convert_function; + if ((f == NULL) + || (NULL == (ap_c = (VOID_STAR) (*f) (ap, na)))) + { + if (bp_c != bp) SLfree ((char *)bp_c); + return -1; + } + a_type = c_type; a_indx = c_indx; + binfun = Binary_Matrixa_indxb_indx.bin_op_function; + } + + if (binfun != NULL) + ret = (*binfun) (op, a_type, ap_c, na, b_type, bp_c, nb, cp); + else + { + SLang_verror (SL_Internal_Error, "No binary function between arithmetic types '%u' and '%u'", + a_type, b_type); + ret = -1; } - return (*binfun) (op, a_type, ap, na, b_type, bp, nb, cp); + if (bp_c != bp) SLfree ((char *) bp_c); + if (ap_c != ap) SLfree ((char *) ap_c); + + return ret; } static int arith_unary_op_result (int op, SLtype a, SLtype *b) @@ -1671,6 +1436,7 @@ }; #endif +#if SLANG_HAS_FLOAT static SLang_FConstant_Type FConst_Table = { #if defined(FLT_MIN) && defined(FLT_MAX) @@ -1694,6 +1460,7 @@ #endif SLANG_END_DCONST_TABLE }; +#endif /* SLANG_HAS_FLOAT */ static void compute_inf_an_nan (void) { @@ -1729,6 +1496,46 @@ #endif } +static int get_table_index (SLtype a_type) +{ + int a_indx = TYPE_TO_TABLE_INDEX(a_type); + if ((a_indx < 0) || (a_indx >= MAX_ARITHMETIC_TYPES)) + { + SLang_verror (SL_Internal_Error, "Type %u does not appear to be arithmetic", a_type); + return -1; + } + return a_indx; +} + +/* Make sure that binary operations between the types are supported */ +static int check_binary_operation (SLtype a_type, SLtype b_type) +{ + int a_indx, b_indx, c_indx; + SLtype c_type; + + if (-1 == (a_indx = get_table_index (a_type))) + return -1; + if (-1 == (b_indx = get_table_index (b_type))) + return -1; + + if (NULL != Binary_Matrixa_indxb_indx.bin_op_function) + return 0; + + /* See if promotion to a common type can be used */ + c_type = promote_to_common_type (a_type, b_type); + if (-1 == (c_indx = get_table_index (c_type))) + return -1; + + if ((Binary_Matrixa_indxc_indx.convert_function != NULL) + && (Binary_Matrixb_indxc_indx.convert_function != NULL)) + return 0; + + SLang_verror (SL_Internal_Error, "Unable to perform binary operation between arithmetic types %u and %u", + a_type, b_type); + return -1; +} + + int _pSLarith_register_types (void) { SLang_Class_Type *cl; @@ -1835,21 +1642,23 @@ for (j = 0; j < MAX_ARITHMETIC_TYPES; j++) { - int implicit_ok; - b_type = _pSLarith_Arith_Typesj; if (b_type == 0) continue; - /* Allow implicit typecast, except from int to float */ - implicit_ok = ((b_type >= SLANG_FLOAT_TYPE) - || (a_type < SLANG_FLOAT_TYPE)); + if (-1 == check_binary_operation (a_type, b_type)) + return -1; if (-1 == SLclass_add_binary_op (a_type, b_type, arith_bin_op, arith_bin_op_result)) return -1; if (a_type != b_type) - if (-1 == SLclass_add_typecast (a_type, b_type, _pSLarith_typecast, implicit_ok)) - return -1; + { + /* Allow implicit typecast, except from int to float */ + int implicit_ok = ((b_type >= SLANG_FLOAT_TYPE) + || (a_type < SLANG_FLOAT_TYPE)); + if (-1 == SLclass_add_typecast (a_type, b_type, _pSLarith_typecast, implicit_ok)) + return -1; + } } } @@ -1950,39 +1759,29 @@ switch (a_type) { case SLANG_CHAR_TYPE: - return int_int_scalar_bin_op (oa->v.char_val, ob->v.char_val, op); + return char_char_scalar_bin_op (oa->v.char_val, ob->v.char_val, op); case SLANG_UCHAR_TYPE: - return int_int_scalar_bin_op (oa->v.uchar_val, ob->v.uchar_val, op); + return uchar_uchar_scalar_bin_op (oa->v.uchar_val, ob->v.uchar_val, op); case SLANG_SHORT_TYPE: - return int_int_scalar_bin_op (oa->v.short_val, ob->v.short_val, op); + return short_short_scalar_bin_op (oa->v.short_val, ob->v.short_val, op); case SLANG_USHORT_TYPE: -# if SHORT_IS_INT - return uint_uint_scalar_bin_op (oa->v.ushort_val, ob->v.ushort_val, op); -# else - return int_int_scalar_bin_op ((int)oa->v.ushort_val, (int)ob->v.ushort_val, op); -# endif + return ushort_ushort_scalar_bin_op (oa->v.ushort_val, ob->v.ushort_val, op); -#if LONG_IS_INT - case SLANG_LONG_TYPE: -#endif case SLANG_INT_TYPE: return int_int_scalar_bin_op (oa->v.int_val, ob->v.int_val, op); -#if LONG_IS_INT - case SLANG_ULONG_TYPE: -#endif case SLANG_UINT_TYPE: return uint_uint_scalar_bin_op (oa->v.uint_val, ob->v.uint_val, op); -#if LONG_IS_NOT_INT case SLANG_LONG_TYPE: return long_long_scalar_bin_op (oa->v.long_val, ob->v.long_val, op); + case SLANG_ULONG_TYPE: return ulong_ulong_scalar_bin_op (oa->v.ulong_val, ob->v.ulong_val, op); -#endif + #ifdef HAVE_LONG_LONG case SLANG_LLONG_TYPE: return llong_llong_scalar_bin_op (oa->v.llong_val, ob->v.llong_val, op);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slarith.inc -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slarith.inc
Changed
@@ -8,12 +8,50 @@ /* The following macros should be properly defined before including this file: * + * For unary operations: (op a) + * GENERIC_UNARY_FUNCTION Name of the unary function + * GENERIC_A_TYPE: The class data type + * GENERIC_A_IS_UNSIGNED Indicates that the type is unsigned + * GENERIC_BIT_OPERATIONS If defined, include SLANG_BNOT + * ABS_FUNCTION: Name of the abs function + * + * For binary operations involving arrays: (a op b) * GENERIC_BINARY_FUNCTION: The name of the binary function - * GENERIC_TYPE: The class data type + * GENERIC_A_TYPE: The class data type for 'a' + * GENERIC_B_TYPE: The class data type for 'b + * GENERIC_B_TYPE_UNSIGNED: Define it 'b' is unsigned + * JUST_BOOLEAN_BINARY_OPS If defined, only "==", "!=", "or", "and" implemented + * GENERIC_BIT_OPERATIONS Include bit ops: "&", "xor", "|", "<<", ">>" + * POW_FUNCTION Used to compute the a^b operation + * POW_RESULT_TYPE The type of the result of a^b + * TRAP_DIV_ZERO required: if 1, throw SL_DIVIDE_ERROR exception * MOD_FUNCTION: The function to use for mod - * ABS_FUNCTION: Name of the abs function - * SIGN_FUNCTION: Name of the sign function - * GENERIC_UNARY_FUNCTION Name of the unary function + * + * For scalar (non-array) binary operations ( a op b) + * SCALAR_BINARY_FUNCTION: The name of the scalar binary function + * GENERIC_A_TYPE: The class data type for 'a' + * GENERIC_B_TYPE: The class data type for 'b' + * GENERIC_B_TYPE_UNSIGNED Define it 'b' is unsigned + * PUSH_SCALAR_OBJ_FUN Used to push the result of (a op b) + * POW_FUNCTION Used to compute the a^b operation + * PUSH_POW_OBJ_FUN Function used to push the result of (a^b) + * TRAP_DIV_ZERO required: If 1 throw SL_DIVIDE_ERROR exception + * GENERIC_BIT_OPERATIONS Include bit op: "&", "xor", "|", "<<", ">>" + * MOD_FUNCTION: The function to use for mod + * + * Copy functions: Copy the an array of type A to B + * GENERIC_COPY_FUNCTION Name of function + * GENERIC_A_TYPE Specifies the type A + * GENERIC_B_TYPE Specifies the type B + * + * Convert functions: Creates an array of type B initialized to values of A + * GENERIC_CONVERT_FUNCTION The name of the function + * GENERIC_A_TYPE Specifies the type A + * GENERIC_B_TYPE Specifies the type B + * + * Conversion to a double: returns a single double via a typecast + * TO_DOUBLE_FUNCTION Name of the function + * GENERIC_A_TYPE The type of that is typecast to double * * If GENERIC_BIT_OPERATIONS is defined, the bit-level binary operators * will get included. If the data type has a power operation (SLANG_POW), @@ -23,6 +61,94 @@ * * If division by zero errors should be trapped, the define TRAP_DIV_ZERO to 1 */ + +#define UNROLL_SOME_LOOPS 1 +#if UNROLL_SOME_LOOPS +# define UNROLL_THIS_ab(_c, _a, _op, _b, _n, _na) \ + (_n) = 0; \ + while ((_n) + 4 <= (_na)) \ + { \ + (_c)(_n) = _a(_n) _op _b(_n); \ + (_c)(_n)+1 = _a(_n)+1 _op _b(_n)+1; \ + (_c)(_n)+2 = _a(_n)+2 _op _b(_n)+2; \ + (_c)(_n)+3 = _a(_n)+3 _op _b(_n)+3; \ + n += 4; \ + } \ + while ((_n) < (_na)) { (_c)(_n) = _a(_n) _op _b(_n); (_n)++; } (void)0 + +# define UNROLL_THIS_a(_c, _a, _op, _b, _n, _na) \ + (_n) = 0; \ + while ((_n) + 4 <= (_na)) \ + { \ + (_c)(_n) = _a(_n) _op _b; \ + (_c)(_n)+1 = _a(_n)+1 _op _b; \ + (_c)(_n)+2 = _a(_n)+2 _op _b; \ + (_c)(_n)+3 = _a(_n)+3 _op _b; \ + n += 4; \ + } \ + while ((_n) < (_na)) { (_c)(_n) = _a(_n) _op _b; (_n)++; } (void)0 + +# define UNROLL_THIS_b(_c, _a, _op, _b, _n, _na) \ + (_n) = 0; \ + while ((_n) + 4 <= (_na)) \ + { \ + (_c)(_n) = _a _op _b(_n); \ + (_c)(_n)+1 = _a _op _b(_n)+1; \ + (_c)(_n)+2 = _a _op _b(_n)+2; \ + (_c)(_n)+3 = _a _op _b(_n)+3; \ + n += 4; \ + } \ + while ((_n) < (_na)) { (_c)(_n) = _a _op _b(_n); (_n)++; } (void)0 +#endif /* UNROLL_SOME_LOOPS */ + +#ifndef TRAP_DIV_ZERO +# define TRAP_DIV_ZERO 0 +#endif + +#if TRAP_DIV_ZERO +# ifdef GENERIC_B_TYPE_UNSIGNED +# define PERFORM_DIVIDE(_c, _a, _b) \ + if ((_b) == 0) \ + { \ + SLang_set_error (SL_DIVIDE_ERROR); \ + return -1; \ + } \ + else (_c) = (_a) / (_b) +# define PERFORM_MOD(_c, _a, _b) \ + if ((_b) == 0) \ + { \ + SLang_set_error (SL_DIVIDE_ERROR); \ + return -1; \ + }\ + else (_c) = MOD_FUNCTION((_a), (_b)) + +# else + +# define PERFORM_DIVIDE(_c, _a, _b) \ + if ((_b) == 0) \ + { \ + SLang_set_error (SL_DIVIDE_ERROR); \ + return -1; \ + } \ + else if ((_b) == -1) (_c) = -(_a); \ + else (_c) = (_a) / (_b) + +# define PERFORM_MOD(_c, _a, _b) \ + if ((_b) == 0) \ + { \ + SLang_set_error (SL_DIVIDE_ERROR); \ + return -1; \ + }\ + else if (_b == -1) (_c) = 0; \ + else (_c) = MOD_FUNCTION((_a), (_b)) + +# endif /* GENERIC_B_TYPE_UNSIGNED */ +#else +# define PERFORM_DIVIDE(_c, _a, _b) (_c) = (_a) / (_b) +# define PERFORM_MOD(_c, _a, _b) (_c) = MOD_FUNCTION((_a), (_b)) +#endif /* TRAP_DIV_ZERO */ + + #ifdef GENERIC_BINARY_FUNCTION static int GENERIC_BINARY_FUNCTION @@ -31,9 +157,11 @@ SLtype b_type, VOID_STAR bp, SLuindex_Type nb, VOID_STAR cp) { - GENERIC_TYPE *a, *b; + GENERIC_A_TYPE *a; + GENERIC_B_TYPE *b; + # ifndef JUST_BOOLEAN_BINARY_OPS - GENERIC_TYPE *c; + GENERIC_C_TYPE *c; # endif # ifdef POW_FUNCTION POW_RESULT_TYPE *d; @@ -47,10 +175,10 @@ (void) a_type; /* Both SLANG_INT_TYPE */ (void) b_type; - a = (GENERIC_TYPE *) ap; - b = (GENERIC_TYPE *) bp; + a = (GENERIC_A_TYPE *) ap; + b = (GENERIC_B_TYPE *) bp; #ifndef JUST_BOOLEAN_BINARY_OPS - c = (GENERIC_TYPE *) cp; + c = (GENERIC_C_TYPE *) cp; #endif cc = (char *) cp; @@ -83,7 +211,7 @@ } else if (nb == 1) { - GENERIC_TYPE xb = *b; + GENERIC_B_TYPE xb = *b; if (xb == 2) for (n = 0; n < na; n++) dn = (double)an * (double)an; @@ -93,7 +221,7 @@ } else /* if (na == 1) */ { - GENERIC_TYPE xa = *a; + GENERIC_A_TYPE xa = *a; for (n = 0; n < nb; n++) dn = POW_FUNCTION(xa, bn); } @@ -109,22 +237,31 @@ # else if (na == nb) { - for (n = 0; n < na; n++) - cn = an + bn; +# if UNROLL_SOME_LOOPS + UNROLL_THIS_ab(c,a,+,b,n,na); +# else + for (n = 0; n < na; n++) cn = an + bn; +# endif } else if (nb == 1) { - GENERIC_TYPE xb = *b; - for (n = 0; n < na; n++) - cn = an + xb; + GENERIC_B_TYPE xb = *b; +# if UNROLL_SOME_LOOPS + UNROLL_THIS_a(c,a,+,xb,n,na); +# else + for (n = 0; n < na; n++) cn = an + xb; +# endif } else /* if (na == 1) */ { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - cn = xa + bn; + GENERIC_A_TYPE xa = *a; +# if UNROLL_SOME_LOOPS + UNROLL_THIS_b(c,xa,+,b,n,nb); +# else + for (n = 0; n < nb; n++) cn = xa + bn; +# endif } -# endif +# endif /* SLANG_OPTIMIZE_FOR_SPEED < 2 */ break; case SLANG_MINUS: @@ -136,20 +273,29 @@ # else if (na == nb) { - for (n = 0; n < na; n++) - cn = an - bn; +# if UNROLL_SOME_LOOPS + UNROLL_THIS_ab(c,a,-,b,n,na); +# else + for (n = 0; n < na; n++) cn = an - bn; +# endif } else if (nb == 1) { - GENERIC_TYPE xb = *b; - for (n = 0; n < na; n++) - cn = an - xb; + GENERIC_B_TYPE xb = *b; +# if UNROLL_SOME_LOOPS + UNROLL_THIS_a(c,a,-,xb,n,na); +# else + for (n = 0; n < na; n++) cn = an - xb; +# endif } else /* if (na == 1) */ { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - cn = xa - bn; + GENERIC_A_TYPE xa = *a; +# if UNROLL_SOME_LOOPS + UNROLL_THIS_b(c,xa,-,b,n,nb); +# else + for (n = 0; n < nb; n++) cn = xa - bn; +# endif } # endif break; @@ -163,20 +309,30 @@ # else if (na == nb) { - for (n = 0; n < na; n++) - cn = an * bn; +# if UNROLL_SOME_LOOPS + UNROLL_THIS_ab(c,a,*,b,n,na); +# else + for (n = 0; n < na; n++) cn = an * bn; +# endif } else if (nb == 1) { - GENERIC_TYPE xb = *b; - for (n = 0; n < na; n++) - cn = an * xb; + GENERIC_B_TYPE xb = *b; +# if UNROLL_SOME_LOOPS + UNROLL_THIS_a(c,a,*,xb,n,na); +# else + for (n = 0; n < na; n++) cn = an * xb; +# endif } else /* if (na == 1) */ { - GENERIC_TYPE xa = *a; + GENERIC_A_TYPE xa = *a; +# if UNROLL_SOME_LOOPS + UNROLL_THIS_b(c,xa,*,b,n,nb); +# else for (n = 0; n < nb; n++) cn = xa * bn; +# endif } # endif break; @@ -185,57 +341,39 @@ # if SLANG_OPTIMIZE_FOR_SPEED < 2 for (n = 0; n < n_max; n++) { -# if TRAP_DIV_ZERO - if (*b == 0) - { - SLang_set_error (SL_DIVIDE_ERROR); - return -1; - } -# endif - cn = (*a / *b); a += da; b += db; + PERFORM_DIVIDE(cn, *a, *b); + a += da; + b += db; } # else if (na == nb) { for (n = 0; n < na; n++) - { -# if TRAP_DIV_ZERO - if (bn == 0) - { - SLang_set_error (SL_DIVIDE_ERROR); - return -1; - } -# endif - cn = an / bn; - } + PERFORM_DIVIDE(cn, an, bn); } else if (nb == 1) { - GENERIC_TYPE xb = *b; + GENERIC_B_TYPE xb = *b; # if TRAP_DIV_ZERO if (xb == 0) { SLang_set_error (SL_DIVIDE_ERROR); return -1; } +# ifndef GENERIC_B_TYPE_UNSIGNED + else if (xb == -1) + for (n = 0; n < na; n++) cn = -an; +# endif + else # endif - for (n = 0; n < na; n++) - cn = an / xb; + for (n = 0; n < na; n++) + cn = an / xb; } else /* if (na == 1) */ { - GENERIC_TYPE xa = *a; + GENERIC_A_TYPE xa = *a; for (n = 0; n < nb; n++) - { -# if TRAP_DIV_ZERO - if (bn == 0) - { - SLang_set_error (SL_DIVIDE_ERROR); - return -1; - } -# endif - cn = xa / bn; - } + PERFORM_DIVIDE(cn, xa, bn); } # endif break; @@ -244,57 +382,26 @@ # if SLANG_OPTIMIZE_FOR_SPEED < 2 for (n = 0; n < n_max; n++) { -# if TRAP_DIV_ZERO - if (*b == 0) - { - SLang_set_error (SL_DIVIDE_ERROR); - return -1; - } -# endif - cn = MOD_FUNCTION(*a, *b); a += da; b += db; + PERFORM_MOD(cn, *a, *b); + a += da; b += db; } # else if (na == nb) { for (n = 0; n < na; n++) - { -# if TRAP_DIV_ZERO - if (bn == 0) - { - SLang_set_error (SL_DIVIDE_ERROR); - return -1; - } -# endif - cn = MOD_FUNCTION(an,bn); - } + PERFORM_MOD(cn, an, bn); } else if (nb == 1) { - GENERIC_TYPE xb = *b; -# if TRAP_DIV_ZERO - if (xb == 0) - { - SLang_set_error (SL_DIVIDE_ERROR); - return -1; - } -# endif + GENERIC_B_TYPE xb = *b; for (n = 0; n < na; n++) - cn = MOD_FUNCTION(an,xb); + PERFORM_MOD(cn, an, xb); } else /* if (na == 1) */ { - GENERIC_TYPE xa = *a; + GENERIC_A_TYPE xa = *a; for (n = 0; n < nb; n++) - { -# if TRAP_DIV_ZERO - if (bn == 0) - { - SLang_set_error (SL_DIVIDE_ERROR); - return -1; - } -# endif - cn = MOD_FUNCTION(xa,bn); - } + PERFORM_MOD(cn, xa, bn); } # endif break; @@ -314,13 +421,13 @@ } else if (nb == 1) { - GENERIC_TYPE xb = *b; + GENERIC_B_TYPE xb = *b; for (n = 0; n < na; n++) cn = an & xb; } else /* if (na == 1) */ { - GENERIC_TYPE xa = *a; + GENERIC_A_TYPE xa = *a; for (n = 0; n < nb; n++) cn = xa & bn; } @@ -341,13 +448,13 @@ } else if (nb == 1) { - GENERIC_TYPE xb = *b; + GENERIC_B_TYPE xb = *b; for (n = 0; n < na; n++) cn = an ^ xb; } else /* if (na == 1) */ { - GENERIC_TYPE xa = *a; + GENERIC_A_TYPE xa = *a; for (n = 0; n < nb; n++) cn = xa ^ bn; } @@ -368,13 +475,13 @@ } else if (nb == 1) { - GENERIC_TYPE xb = *b; + GENERIC_B_TYPE xb = *b; for (n = 0; n < na; n++) cn = an | xb; } else /* if (na == 1) */ { - GENERIC_TYPE xa = *a; + GENERIC_A_TYPE xa = *a; for (n = 0; n < nb; n++) cn = xa | bn; } @@ -395,13 +502,13 @@ } else if (nb == 1) { - GENERIC_TYPE xb = *b; + GENERIC_B_TYPE xb = *b; for (n = 0; n < na; n++) cn = an << xb; } else /* if (na == 1) */ { - GENERIC_TYPE xa = *a; + GENERIC_A_TYPE xa = *a; for (n = 0; n < nb; n++) cn = xa << bn; } @@ -422,13 +529,13 @@ } else if (nb == 1) { - GENERIC_TYPE xb = *b; + GENERIC_B_TYPE xb = *b; for (n = 0; n < na; n++) cn = an >> xb; } else /* if (na == 1) */ { - GENERIC_TYPE xa = *a; + GENERIC_A_TYPE xa = *a; for (n = 0; n < nb; n++) cn = xa >> bn; } @@ -439,25 +546,34 @@ # if SLANG_OPTIMIZE_FOR_SPEED < 2 for (n = 0; n < n_max; n++) { - ccn = (*a > *b); a += da; b += db; + ccn = ((GENERIC_C_TYPE)*a > (GENERIC_C_TYPE)*b); a += da; b += db; } # else if (na == nb) { - for (n = 0; n < na; n++) - ccn = (an > bn); +# if UNROLL_SOME_LOOPS + UNROLL_THIS_ab(cc,(GENERIC_C_TYPE)a,>,(GENERIC_C_TYPE)b,n,na); +# else + for (n = 0; n < na; n++) ccn = ((GENERIC_C_TYPE)an > (GENERIC_C_TYPE)bn); +# endif } else if (nb == 1) { - GENERIC_TYPE xb = *b; - for (n = 0; n < na; n++) - ccn = (an > xb); + GENERIC_C_TYPE xb = *b; +# if UNROLL_SOME_LOOPS + UNROLL_THIS_a(cc,(GENERIC_C_TYPE)a,>,xb,n,na); +# else + for (n = 0; n < na; n++) ccn = ((GENERIC_C_TYPE)an > xb); +# endif } else /* if (na == 1) */ { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - ccn = (xa > bn); + GENERIC_C_TYPE xa = *a; +# if UNROLL_SOME_LOOPS + UNROLL_THIS_b(cc,xa,>,(GENERIC_C_TYPE)b,n,nb); +# else + for (n = 0; n < nb; n++) ccn = (xa > (GENERIC_C_TYPE)bn); +# endif } # endif break; @@ -466,25 +582,34 @@ # if SLANG_OPTIMIZE_FOR_SPEED < 2 for (n = 0; n < n_max; n++) { - ccn = (*a >= *b); a += da; b += db; + ccn = ((GENERIC_C_TYPE)*a >= (GENERIC_C_TYPE)*b); a += da; b += db; } # else if (na == nb) { - for (n = 0; n < na; n++) - ccn = (an >= bn); +# if UNROLL_SOME_LOOPS + UNROLL_THIS_ab(cc,(GENERIC_C_TYPE)a,>=,(GENERIC_C_TYPE)b,n,na); +# else + for (n = 0; n < na; n++) ccn = ((GENERIC_C_TYPE)an >= (GENERIC_C_TYPE)bn); +# endif } else if (nb == 1) { - GENERIC_TYPE xb = *b; - for (n = 0; n < na; n++) - ccn = (an >= xb); + GENERIC_C_TYPE xb = *b; +# if UNROLL_SOME_LOOPS + UNROLL_THIS_a(cc,(GENERIC_C_TYPE)a,>=,xb,n,na); +# else + for (n = 0; n < na; n++) ccn = ((GENERIC_C_TYPE)an >= xb); +# endif } else /* if (na == 1) */ { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - ccn = (xa >= bn); + GENERIC_C_TYPE xa = *a; +# if UNROLL_SOME_LOOPS + UNROLL_THIS_b(cc,xa,>=,(GENERIC_C_TYPE)b,n,nb); +# else + for (n = 0; n < nb; n++) ccn = (xa >= (GENERIC_C_TYPE)bn); +# endif } # endif break; @@ -493,25 +618,34 @@ # if SLANG_OPTIMIZE_FOR_SPEED < 2 for (n = 0; n < n_max; n++) { - ccn = (*a < *b); a += da; b += db; + ccn = ((GENERIC_C_TYPE)*a < (GENERIC_C_TYPE)*b); a += da; b += db; } # else if (na == nb) { - for (n = 0; n < na; n++) - ccn = (an < bn); +# if UNROLL_SOME_LOOPS + UNROLL_THIS_ab(cc,(GENERIC_C_TYPE)a,<,(GENERIC_C_TYPE)b,n,na); +# else + for (n = 0; n < na; n++) ccn = ((GENERIC_C_TYPE)an < (GENERIC_C_TYPE)bn); +# endif } else if (nb == 1) { - GENERIC_TYPE xb = *b; - for (n = 0; n < na; n++) - ccn = (an < xb); + GENERIC_C_TYPE xb = *b; +# if UNROLL_SOME_LOOPS + UNROLL_THIS_a(cc,(GENERIC_C_TYPE)a,<,xb,n,na); +# else + for (n = 0; n < na; n++) ccn = ((GENERIC_C_TYPE)an < xb); +# endif } else /* if (na == 1) */ { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - ccn = (xa < bn); + GENERIC_C_TYPE xa = *a; +# if UNROLL_SOME_LOOPS + UNROLL_THIS_b(cc,xa,<,(GENERIC_C_TYPE)b,n,nb); +# else + for (n = 0; n < nb; n++) ccn = (xa < (GENERIC_C_TYPE)bn); +# endif } # endif break; @@ -520,25 +654,34 @@ # if SLANG_OPTIMIZE_FOR_SPEED < 2 for (n = 0; n < n_max; n++) { - ccn = (*a <= *b); a += da; b += db; + ccn = ((GENERIC_C_TYPE)*a <= (GENERIC_C_TYPE)*b); a += da; b += db; } # else if (na == nb) { - for (n = 0; n < na; n++) - ccn = (an <= bn); +# if UNROLL_SOME_LOOPS + UNROLL_THIS_ab(cc,(GENERIC_C_TYPE)a,<=,(GENERIC_C_TYPE)b,n,na); +# else + for (n = 0; n < na; n++) ccn = ((GENERIC_C_TYPE)an <= (GENERIC_C_TYPE)bn); +# endif } else if (nb == 1) { - GENERIC_TYPE xb = *b; - for (n = 0; n < na; n++) - ccn = (an <= xb); + GENERIC_C_TYPE xb = *b; +# if UNROLL_SOME_LOOPS + UNROLL_THIS_a(cc,(GENERIC_C_TYPE)a,<=,xb,n,na); +# else + for (n = 0; n < na; n++) ccn = ((GENERIC_C_TYPE)an <= xb); +# endif } else /* if (na == 1) */ { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - ccn = (xa <= bn); + GENERIC_C_TYPE xa = *a; +# if UNROLL_SOME_LOOPS + UNROLL_THIS_b(cc,xa,<=,(GENERIC_C_TYPE)b,n,nb); +# else + for (n = 0; n < nb; n++) ccn = (xa <= (GENERIC_C_TYPE)bn); +# endif } # endif break; @@ -549,25 +692,34 @@ # if SLANG_OPTIMIZE_FOR_SPEED < 2 for (n = 0; n < n_max; n++) { - ccn = (*a == *b); a += da; b += db; + ccn = ((GENERIC_C_TYPE)*a == (GENERIC_C_TYPE)*b); a += da; b += db; } # else if (na == nb) { - for (n = 0; n < na; n++) - ccn = (an == bn); +# if UNROLL_SOME_LOOPS + UNROLL_THIS_ab(cc,(GENERIC_C_TYPE)a,==,(GENERIC_C_TYPE)b,n,na); +# else + for (n = 0; n < na; n++) ccn = ((GENERIC_C_TYPE)an == (GENERIC_C_TYPE)bn); +# endif } else if (nb == 1) { - GENERIC_TYPE xb = *b; - for (n = 0; n < na; n++) - ccn = (an == xb); + GENERIC_C_TYPE xb = *b; +# if UNROLL_SOME_LOOPS + UNROLL_THIS_a(cc,(GENERIC_C_TYPE)a,==,xb,n,na); +# else + for (n = 0; n < na; n++) ccn = ((GENERIC_C_TYPE)an == xb); +# endif } else /* if (na == 1) */ { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - ccn = (xa == bn); + GENERIC_C_TYPE xa = *a; +# if UNROLL_SOME_LOOPS + UNROLL_THIS_b(cc,xa,==,(GENERIC_C_TYPE)b,n,nb); +# else + for (n = 0; n < nb; n++) ccn = (xa == (GENERIC_C_TYPE)bn); +# endif } # endif break; @@ -576,25 +728,34 @@ # if SLANG_OPTIMIZE_FOR_SPEED < 2 for (n = 0; n < n_max; n++) { - ccn = (*a != *b); a += da; b += db; + ccn = ((GENERIC_C_TYPE)*a != (GENERIC_C_TYPE)*b); a += da; b += db; } # else if (na == nb) { - for (n = 0; n < na; n++) - ccn = (an != bn); +# if UNROLL_SOME_LOOPS + UNROLL_THIS_ab(cc,(GENERIC_C_TYPE)a,!=,(GENERIC_C_TYPE)b,n,na); +# else + for (n = 0; n < na; n++) ccn = ((GENERIC_C_TYPE)an != (GENERIC_C_TYPE)bn); +# endif } else if (nb == 1) { - GENERIC_TYPE xb = *b; - for (n = 0; n < na; n++) - ccn = (an != xb); + GENERIC_C_TYPE xb = *b; +# if UNROLL_SOME_LOOPS + UNROLL_THIS_a(cc,(GENERIC_C_TYPE)a,!=,xb,n,na); +# else + for (n = 0; n < na; n++) ccn = ((GENERIC_C_TYPE)an != xb); +# endif } else /* if (na == 1) */ { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - ccn = (xa != bn); + GENERIC_C_TYPE xa = *a; +# if UNROLL_SOME_LOOPS + UNROLL_THIS_b(cc,xa,!=,(GENERIC_C_TYPE)b,n,nb); +# else + for (n = 0; n < nb; n++) ccn = (xa != (GENERIC_C_TYPE)bn); +# endif } # endif break; @@ -608,20 +769,29 @@ # else if (na == nb) { - for (n = 0; n < na; n++) - ccn = (an || bn); +# if UNROLL_SOME_LOOPS + UNROLL_THIS_ab(cc,a,||,b,n,na); +# else + for (n = 0; n < na; n++) ccn = (an || bn); +# endif } else if (nb == 1) { - GENERIC_TYPE xb = *b; - for (n = 0; n < na; n++) - ccn = (an || xb); + GENERIC_B_TYPE xb = *b; +# if UNROLL_SOME_LOOPS + UNROLL_THIS_a(cc,a,||,xb,n,na); +# else + for (n = 0; n < na; n++) ccn = (an || xb); +# endif } else /* if (na == 1) */ { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - ccn = (xa || bn); + GENERIC_A_TYPE xa = *a; +# if UNROLL_SOME_LOOPS + UNROLL_THIS_b(cc,xa,||,b,n,nb); +# else + for (n = 0; n < nb; n++) ccn = (xa || bn); +# endif } # endif break; @@ -635,20 +805,29 @@ # else if (na == nb) { - for (n = 0; n < na; n++) - ccn = (an && bn); +# if UNROLL_SOME_LOOPS + UNROLL_THIS_ab(cc,a,&&,b,n,na); +# else + for (n = 0; n < na; n++) ccn = (an && bn); +# endif } else if (nb == 1) { - GENERIC_TYPE xb = *b; - for (n = 0; n < na; n++) - ccn = (an && xb); + GENERIC_B_TYPE xb = *b; +# if UNROLL_SOME_LOOPS + UNROLL_THIS_a(cc,a,&&,xb,n,na); +# else + for (n = 0; n < na; n++) ccn = (an && xb); +# endif } else /* if (na == 1) */ { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - ccn = (xa && bn); + GENERIC_A_TYPE xa = *a; +# if UNROLL_SOME_LOOPS + UNROLL_THIS_b(cc,xa,&&,b,n,nb); +# else + for (n = 0; n < nb; n++) ccn = (xa && bn); +# endif } # endif break; @@ -666,15 +845,16 @@ VOID_STAR bp ) { - GENERIC_TYPE *a, *b; + GENERIC_A_TYPE *a; + GENERIC_B_TYPE *b; SLuindex_Type n; int *ib; char *cb; (void) a_type; - a = (GENERIC_TYPE *) ap; - b = (GENERIC_TYPE *) bp; + a = (GENERIC_A_TYPE *) ap; + b = (GENERIC_B_TYPE *) bp; switch (op) { @@ -693,7 +873,13 @@ case SLANG_SIGN: ib = (int *) bp; for (n = 0; n < na; n++) - ibn = SIGN_FUNCTION(an); + { +# ifdef GENERIC_A_TYPE_UNSIGNED + ibn = (an != 0); +#else + ibn = ((an > 0) ? 1 : ((an < 0) ? -1 : 0)); +#endif + } break; case SLANG_SQR: for (n = 0; n < na; n++) bn = (an * an); @@ -702,7 +888,7 @@ for (n = 0; n < na; n++) bn = (2 * an); break; case SLANG_CHS: - for (n = 0; n < na; n++) bn = (GENERIC_TYPE) -(an); + for (n = 0; n < na; n++) bn = (GENERIC_B_TYPE) -(an); break; case SLANG_NOT: @@ -721,7 +907,7 @@ break; case SLANG_ISNEG: cb = (char *) bp; -# ifdef GENERIC_TYPE_IS_UNSIGNED +# ifdef GENERIC_A_TYPE_UNSIGNED for (n = 0; n < na; n++) cbn = 0; # else for (n = 0; n < na; n++) cbn = (an < 0); @@ -729,7 +915,7 @@ break; case SLANG_ISNONNEG: cb = (char *) bp; -# ifdef GENERIC_TYPE_IS_UNSIGNED +# ifdef GENERIC_A_TYPE_UNSIGNED for (n = 0; n < na; n++) cbn = 1; # else for (n = 0; n < na; n++) cbn = (an >= 0); @@ -741,9 +927,9 @@ } #endif /* GENERIC_UNARY_FUNCTION */ -#ifdef SCALAR_BINARY_FUNCTION +#if defined(SCALAR_BINARY_FUNCTION) && SLANG_OPTIMIZE_FOR_SPEED -static int SCALAR_BINARY_FUNCTION (GENERIC_TYPE a, GENERIC_TYPE b, int op) +static int SCALAR_BINARY_FUNCTION (GENERIC_A_TYPE a, GENERIC_B_TYPE b, int op) { switch (op) { @@ -762,23 +948,17 @@ case SLANG_TIMES: return PUSH_SCALAR_OBJ_FUN (a * b); case SLANG_DIVIDE: -# if TRAP_DIV_ZERO - if (b == 0) { - SLang_set_error (SL_DIVIDE_ERROR); - return -1; + GENERIC_C_TYPE c; + PERFORM_DIVIDE(c, a, b); + return PUSH_SCALAR_OBJ_FUN (c); } -# endif - return PUSH_SCALAR_OBJ_FUN (a / b); case SLANG_MOD: -# if TRAP_DIV_ZERO - if (b == 0) { - SLang_set_error (SL_DIVIDE_ERROR); - return -1; + GENERIC_A_TYPE c; + PERFORM_MOD(c, a, b); + return PUSH_SCALAR_OBJ_FUN (c); } -# endif - return PUSH_SCALAR_OBJ_FUN (MOD_FUNCTION(a,b)); # ifdef GENERIC_BIT_OPERATIONS case SLANG_BAND: return PUSH_SCALAR_OBJ_FUN (a & b); @@ -807,11 +987,12 @@ #ifdef CMP_FUNCTION static int CMP_FUNCTION (SLtype unused, VOID_STAR a, VOID_STAR b, int *c) { - GENERIC_TYPE x, y; + GENERIC_A_TYPE x; + GENERIC_B_TYPE y; (void) unused; - x = *(GENERIC_TYPE *) a; - y = *(GENERIC_TYPE *) b; + x = *(GENERIC_A_TYPE *) a; + y = *(GENERIC_B_TYPE *) b; if (x > y) *c = 1; else if (x == y) *c = 0; @@ -822,10 +1003,10 @@ #endif #ifdef TO_BINARY_FUNCTION -static int TO_BINARY_FUNCTION (GENERIC_TYPE x, char *buf, unsigned int buflen, +static int TO_BINARY_FUNCTION (GENERIC_A_TYPE x, char *buf, unsigned int buflen, unsigned int min_num_bits) { - GENERIC_TYPE x1; + GENERIC_A_TYPE x1; unsigned int nbits; char *s; @@ -859,6 +1040,52 @@ } #endif +#ifdef GENERIC_COPY_FUNCTION +static void GENERIC_COPY_FUNCTION (GENERIC_B_TYPE *b, GENERIC_A_TYPE *a, SLuindex_Type n) +{ + SLuindex_Type i; + for (i = 0; i < n; i++) bi = (GENERIC_B_TYPE) ai; +} +#endif + +#ifdef GENERIC_CONVERT_FUNCTION +static VOID_STAR GENERIC_CONVERT_FUNCTION (VOID_STAR ap, SLuindex_Type n) +{ + GENERIC_A_TYPE *a = (GENERIC_A_TYPE *)ap; + GENERIC_B_TYPE *b; + SLuindex_Type i; + + if (NULL == (b = (GENERIC_B_TYPE *)_SLcalloc (n, sizeof(GENERIC_B_TYPE)))) + return NULL; + for (i = 0; i < n; i++) bi = (GENERIC_B_TYPE)ai; + return (VOID_STAR) b; +} +#endif + +#if SLANG_HAS_FLOAT +# ifdef TO_DOUBLE_FUNCTION +static double TO_DOUBLE_FUNCTION (VOID_STAR ap) +{ + return (double) *(GENERIC_A_TYPE *)ap; +} +# endif +#endif + +#ifndef CONVERT_TO_SELF_DEFINED +# define CONVERT_TO_SELF_DEFINED 1 +/* This function is used when converting between signed and unsigned versions + * of integers of the same size. Applicable to all datatypes + */ +static VOID_STAR convert_self_to_self (VOID_STAR ap, SLuindex_Type n) +{ + (void) n; + return ap; +} +#endif /* CONVERT_TO_SELF_DEFINED */ + +#undef TO_DOUBLE_FUNCTION +#undef GENERIC_CONVERT_FUNCTION +#undef GENERIC_COPY_FUNCTION #undef TO_BINARY_FUNCTION #undef CMP_FUNCTION #undef SCALAR_BINARY_FUNCTION @@ -867,13 +1094,20 @@ #undef GENERIC_BINARY_FUNCTION #undef GENERIC_UNARY_FUNCTION #undef GENERIC_BIT_OPERATIONS -#undef GENERIC_TYPE +#undef GENERIC_A_TYPE +#undef GENERIC_B_TYPE +#undef GENERIC_C_TYPE #undef POW_FUNCTION #undef POW_RESULT_TYPE #undef MOD_FUNCTION #undef ABS_FUNCTION -#undef SIGN_FUNCTION -#undef GENERIC_TYPE_IS_UNSIGNED -#undef GENERIC_ARITH_UNARY_FUNCTION +#undef GENERIC_A_TYPE_UNSIGNED +#undef GENERIC_B_TYPE_UNSIGNED #undef JUST_BOOLEAN_BINARY_OPS #undef TRAP_DIV_ZERO +#undef UNROLL_SOME_LOOPS +#undef UNROLL_THIS_ab +#undef UNROLL_THIS_b +#undef UNROLL_THIS_a +#undef PERFORM_MOD +#undef PERFORM_DIVIDE
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slarith2.inc -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slarith2.inc
Changed
@@ -1,1418 +1,4057 @@ /* DO NOT EDIT -- this file was generated by src/util/mkslarith2.sl */ -/* ------------ signed char ---------- */ -DEFUN_1(copy_char_to_char,signed char,signed char) -#define char_to_char NULL -#define copy_char_to_uchar copy_char_to_char -#define char_to_uchar NULL -DEFUN_1(copy_char_to_short,signed char,short) -#define char_to_short NULL -DEFUN_1(copy_char_to_ushort,signed char,unsigned short) -#define char_to_ushort NULL -DEFUN_1(copy_char_to_int,signed char,int) -DEFUN_2(char_to_int,signed char,int,copy_char_to_int) -DEFUN_1(copy_char_to_uint,signed char,unsigned int) -DEFUN_2(char_to_uint,signed char,unsigned int,copy_char_to_uint) -#if LONG_IS_INT -# define copy_char_to_long copy_char_to_int -#else -DEFUN_1(copy_char_to_long,signed char,long) -#endif -#if LONG_IS_INT -# define char_to_long char_to_int -#else -DEFUN_2(char_to_long,signed char,long,copy_char_to_long) -#endif -#if LONG_IS_INT -# define copy_char_to_ulong copy_char_to_uint -#else -DEFUN_1(copy_char_to_ulong,signed char,unsigned long) -#endif -#if LONG_IS_INT -# define char_to_ulong char_to_uint -#else -DEFUN_2(char_to_ulong,signed char,unsigned long,copy_char_to_ulong) -#endif -#if defined(HAVE_LONG_LONG) -DEFUN_1(copy_char_to_llong,signed char,long long) -DEFUN_2(char_to_llong,signed char,long long,copy_char_to_llong) -#endif /* defined(HAVE_LONG_LONG) */ -#if defined(HAVE_LONG_LONG) -DEFUN_1(copy_char_to_ullong,signed char,unsigned long long) -DEFUN_2(char_to_ullong,signed char,unsigned long long,copy_char_to_ullong) -#endif /* defined(HAVE_LONG_LONG) */ -#if SLANG_HAS_FLOAT -DEFUN_1(copy_char_to_float,signed char,float) -DEFUN_2(char_to_float,signed char,float,copy_char_to_float) -#endif /* SLANG_HAS_FLOAT */ -#if SLANG_HAS_FLOAT -DEFUN_1(copy_char_to_double,signed char,double) -DEFUN_2(char_to_double,signed char,double,copy_char_to_double) -#endif /* SLANG_HAS_FLOAT */ -#if defined(HAVE_LONG_DOUBLE) -DEFUN_1(copy_char_to_ldouble,signed char,long double) -DEFUN_2(char_to_ldouble,signed char,long double,copy_char_to_ldouble) -#endif /* defined(HAVE_LONG_DOUBLE) */ -#if SLANG_HAS_FLOAT -TO_DOUBLE_FUN(char_to_one_double,signed char) -#endif +/* signed char */ +/* (signed char, signed char) */ +#define GENERIC_BINARY_FUNCTION char_char_bin_op +#define GENERIC_A_TYPE signed char +#define GENERIC_B_TYPE signed char +#define GENERIC_C_TYPE int +#define GENERIC_BIT_OPERATIONS 1 +#define TRAP_DIV_ZERO 1 +#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) +#define POW_RESULT_TYPE double +#define MOD_FUNCTION(a,b) ((a) % (b)) +#define char_char_scalar_bin_op int_int_scalar_bin_op +#define GENERIC_UNARY_FUNCTION char_unary_op +#define ABS_FUNCTION(a) abs(a) +#define CMP_FUNCTION char_cmp_function +#define TO_DOUBLE_FUNCTION char_to_one_double +#define GENERIC_COPY_FUNCTION copy_char_to_char +#define char_to_char char_to_int +#include "slarith.inc" -/* ------------ unsigned char ---------- */ -#define copy_uchar_to_char copy_char_to_char -#define uchar_to_char NULL -#define copy_uchar_to_uchar copy_char_to_char -#define uchar_to_uchar NULL -DEFUN_1(copy_uchar_to_short,unsigned char,short) -#define uchar_to_short NULL -DEFUN_1(copy_uchar_to_ushort,unsigned char,unsigned short) -#define uchar_to_ushort NULL -DEFUN_1(copy_uchar_to_int,unsigned char,int) -DEFUN_2(uchar_to_int,unsigned char,int,copy_uchar_to_int) -DEFUN_1(copy_uchar_to_uint,unsigned char,unsigned int) -DEFUN_2(uchar_to_uint,unsigned char,unsigned int,copy_uchar_to_uint) -#if LONG_IS_INT -# define copy_uchar_to_long copy_uchar_to_int -#else -DEFUN_1(copy_uchar_to_long,unsigned char,long) -#endif -#if LONG_IS_INT -# define uchar_to_long uchar_to_int -#else -DEFUN_2(uchar_to_long,unsigned char,long,copy_uchar_to_long) -#endif -#if LONG_IS_INT -# define copy_uchar_to_ulong copy_uchar_to_uint -#else -DEFUN_1(copy_uchar_to_ulong,unsigned char,unsigned long) -#endif -#if LONG_IS_INT -# define uchar_to_ulong uchar_to_uint -#else -DEFUN_2(uchar_to_ulong,unsigned char,unsigned long,copy_uchar_to_ulong) -#endif -#if defined(HAVE_LONG_LONG) -DEFUN_1(copy_uchar_to_llong,unsigned char,long long) -DEFUN_2(uchar_to_llong,unsigned char,long long,copy_uchar_to_llong) -#endif /* defined(HAVE_LONG_LONG) */ -#if defined(HAVE_LONG_LONG) -DEFUN_1(copy_uchar_to_ullong,unsigned char,unsigned long long) -DEFUN_2(uchar_to_ullong,unsigned char,unsigned long long,copy_uchar_to_ullong) -#endif /* defined(HAVE_LONG_LONG) */ -#if SLANG_HAS_FLOAT -DEFUN_1(copy_uchar_to_float,unsigned char,float) -DEFUN_2(uchar_to_float,unsigned char,float,copy_uchar_to_float) -#endif /* SLANG_HAS_FLOAT */ -#if SLANG_HAS_FLOAT -DEFUN_1(copy_uchar_to_double,unsigned char,double) -DEFUN_2(uchar_to_double,unsigned char,double,copy_uchar_to_double) -#endif /* SLANG_HAS_FLOAT */ -#if defined(HAVE_LONG_DOUBLE) -DEFUN_1(copy_uchar_to_ldouble,unsigned char,long double) -DEFUN_2(uchar_to_ldouble,unsigned char,long double,copy_uchar_to_ldouble) -#endif /* defined(HAVE_LONG_DOUBLE) */ -#if SLANG_HAS_FLOAT -TO_DOUBLE_FUN(uchar_to_one_double,unsigned char) -#endif +/* (signed char, unsigned char) */ +#define char_uchar_bin_op NULL +#define GENERIC_A_TYPE signed char +#define GENERIC_B_TYPE unsigned char +#define GENERIC_B_TYPE_UNSIGNED 1 +#define GENERIC_C_TYPE int +#define GENERIC_BIT_OPERATIONS 1 +#define TRAP_DIV_ZERO 1 +#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) +#define POW_RESULT_TYPE double +#define MOD_FUNCTION(a,b) ((a) % (b)) +#define copy_char_to_uchar copy_char_to_char +#define char_to_uchar char_to_int +#include "slarith.inc" -/* ------------ short ---------- */ -DEFUN_1(copy_short_to_char,short,signed char) -#define short_to_char NULL -DEFUN_1(copy_short_to_uchar,short,unsigned char) -#define short_to_uchar NULL -DEFUN_1(copy_short_to_short,short,short) -#define short_to_short NULL -#define copy_short_to_ushort copy_short_to_short -#define short_to_ushort NULL -DEFUN_1(copy_short_to_int,short,int) -DEFUN_2(short_to_int,short,int,copy_short_to_int) -DEFUN_1(copy_short_to_uint,short,unsigned int) -DEFUN_2(short_to_uint,short,unsigned int,copy_short_to_uint) -#if LONG_IS_INT -# define copy_short_to_long copy_short_to_int -#else -DEFUN_1(copy_short_to_long,short,long) -#endif -#if LONG_IS_INT -# define short_to_long short_to_int -#else -DEFUN_2(short_to_long,short,long,copy_short_to_long) -#endif -#if LONG_IS_INT -# define copy_short_to_ulong copy_short_to_uint -#else -DEFUN_1(copy_short_to_ulong,short,unsigned long) -#endif -#if LONG_IS_INT -# define short_to_ulong short_to_uint -#else -DEFUN_2(short_to_ulong,short,unsigned long,copy_short_to_ulong) -#endif -#if defined(HAVE_LONG_LONG) -DEFUN_1(copy_short_to_llong,short,long long) -DEFUN_2(short_to_llong,short,long long,copy_short_to_llong) -#endif /* defined(HAVE_LONG_LONG) */ -#if defined(HAVE_LONG_LONG) -DEFUN_1(copy_short_to_ullong,short,unsigned long long) -DEFUN_2(short_to_ullong,short,unsigned long long,copy_short_to_ullong) -#endif /* defined(HAVE_LONG_LONG) */ -#if SLANG_HAS_FLOAT -DEFUN_1(copy_short_to_float,short,float) -DEFUN_2(short_to_float,short,float,copy_short_to_float) -#endif /* SLANG_HAS_FLOAT */ -#if SLANG_HAS_FLOAT -DEFUN_1(copy_short_to_double,short,double) -DEFUN_2(short_to_double,short,double,copy_short_to_double) -#endif /* SLANG_HAS_FLOAT */ -#if defined(HAVE_LONG_DOUBLE) -DEFUN_1(copy_short_to_ldouble,short,long double) -DEFUN_2(short_to_ldouble,short,long double,copy_short_to_ldouble) -#endif /* defined(HAVE_LONG_DOUBLE) */ -#if SLANG_HAS_FLOAT -TO_DOUBLE_FUN(short_to_one_double,short) -#endif +/* (signed char, short) */ +#if SHORT_IS_NOT_INT + #define char_short_bin_op NULL + #define GENERIC_A_TYPE signed char + #define GENERIC_B_TYPE short + #define GENERIC_C_TYPE int + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_char_to_short + #define char_to_short char_to_int + #include "slarith.inc" +#else + #define char_short_bin_op char_int_bin_op + #define copy_char_to_short copy_char_to_int + #define char_to_short char_to_int +#endif /* SHORT_IS_NOT_INT */ -/* ------------ unsigned short ---------- */ -DEFUN_1(copy_ushort_to_char,unsigned short,signed char) -#define ushort_to_char NULL -DEFUN_1(copy_ushort_to_uchar,unsigned short,unsigned char) -#define ushort_to_uchar NULL -#define copy_ushort_to_short copy_short_to_short -#define ushort_to_short NULL -#define copy_ushort_to_ushort copy_short_to_short -#define ushort_to_ushort NULL -DEFUN_1(copy_ushort_to_int,unsigned short,int) -DEFUN_2(ushort_to_int,unsigned short,int,copy_ushort_to_int) -DEFUN_1(copy_ushort_to_uint,unsigned short,unsigned int) -DEFUN_2(ushort_to_uint,unsigned short,unsigned int,copy_ushort_to_uint) -#if LONG_IS_INT -# define copy_ushort_to_long copy_ushort_to_int -#else -DEFUN_1(copy_ushort_to_long,unsigned short,long) -#endif -#if LONG_IS_INT -# define ushort_to_long ushort_to_int -#else -DEFUN_2(ushort_to_long,unsigned short,long,copy_ushort_to_long) -#endif -#if LONG_IS_INT -# define copy_ushort_to_ulong copy_ushort_to_uint -#else -DEFUN_1(copy_ushort_to_ulong,unsigned short,unsigned long) -#endif -#if LONG_IS_INT -# define ushort_to_ulong ushort_to_uint -#else -DEFUN_2(ushort_to_ulong,unsigned short,unsigned long,copy_ushort_to_ulong) -#endif -#if defined(HAVE_LONG_LONG) -DEFUN_1(copy_ushort_to_llong,unsigned short,long long) -DEFUN_2(ushort_to_llong,unsigned short,long long,copy_ushort_to_llong) -#endif /* defined(HAVE_LONG_LONG) */ -#if defined(HAVE_LONG_LONG) -DEFUN_1(copy_ushort_to_ullong,unsigned short,unsigned long long) -DEFUN_2(ushort_to_ullong,unsigned short,unsigned long long,copy_ushort_to_ullong) -#endif /* defined(HAVE_LONG_LONG) */ -#if SLANG_HAS_FLOAT -DEFUN_1(copy_ushort_to_float,unsigned short,float) -DEFUN_2(ushort_to_float,unsigned short,float,copy_ushort_to_float) -#endif /* SLANG_HAS_FLOAT */ -#if SLANG_HAS_FLOAT -DEFUN_1(copy_ushort_to_double,unsigned short,double) -DEFUN_2(ushort_to_double,unsigned short,double,copy_ushort_to_double) -#endif /* SLANG_HAS_FLOAT */ -#if defined(HAVE_LONG_DOUBLE) -DEFUN_1(copy_ushort_to_ldouble,unsigned short,long double) -DEFUN_2(ushort_to_ldouble,unsigned short,long double,copy_ushort_to_ldouble) -#endif /* defined(HAVE_LONG_DOUBLE) */ -#if SLANG_HAS_FLOAT -TO_DOUBLE_FUN(ushort_to_one_double,unsigned short) -#endif +/* (signed char, unsigned short) */ +#if SHORT_IS_NOT_INT + #define char_ushort_bin_op NULL + #define GENERIC_A_TYPE signed char + #define GENERIC_B_TYPE unsigned short + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE int + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_char_to_ushort + #define char_to_ushort char_to_int + #include "slarith.inc" +#else + #define char_ushort_bin_op char_uint_bin_op + #define copy_char_to_ushort copy_char_to_uint + #define char_to_ushort char_to_uint +#endif /* SHORT_IS_NOT_INT */ -/* ------------ int ---------- */ -DEFUN_1(copy_int_to_char,int,signed char) -#define int_to_char NULL -DEFUN_1(copy_int_to_uchar,int,unsigned char) -#define int_to_uchar NULL -DEFUN_1(copy_int_to_short,int,short) -#define int_to_short NULL -DEFUN_1(copy_int_to_ushort,int,unsigned short) -#define int_to_ushort NULL -DEFUN_1(copy_int_to_int,int,int) -#define int_to_int NULL -#define copy_int_to_uint copy_int_to_int -#define int_to_uint NULL -#if LONG_IS_INT -# define copy_int_to_long copy_int_to_int -#else -DEFUN_1(copy_int_to_long,int,long) -#endif -#if LONG_IS_INT -# define int_to_long int_to_int -#else -DEFUN_2(int_to_long,int,long,copy_int_to_long) -#endif -#if LONG_IS_INT -# define copy_int_to_ulong copy_int_to_uint -#else -DEFUN_1(copy_int_to_ulong,int,unsigned long) -#endif -#if LONG_IS_INT -# define int_to_ulong int_to_uint -#else -DEFUN_2(int_to_ulong,int,unsigned long,copy_int_to_ulong) -#endif -#if defined(HAVE_LONG_LONG) -DEFUN_1(copy_int_to_llong,int,long long) -DEFUN_2(int_to_llong,int,long long,copy_int_to_llong) -#endif /* defined(HAVE_LONG_LONG) */ -#if defined(HAVE_LONG_LONG) -DEFUN_1(copy_int_to_ullong,int,unsigned long long) -DEFUN_2(int_to_ullong,int,unsigned long long,copy_int_to_ullong) +/* (signed char, int) */ +#define GENERIC_BINARY_FUNCTION char_int_bin_op +#define GENERIC_A_TYPE signed char +#define GENERIC_B_TYPE int +#define GENERIC_C_TYPE int +#define GENERIC_BIT_OPERATIONS 1 +#define TRAP_DIV_ZERO 1 +#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) +#define POW_RESULT_TYPE double +#define MOD_FUNCTION(a,b) ((a) % (b)) +#define GENERIC_COPY_FUNCTION copy_char_to_int +#define GENERIC_CONVERT_FUNCTION char_to_int +#include "slarith.inc" + +/* (signed char, unsigned int) */ +#define char_uint_bin_op NULL +#define GENERIC_A_TYPE signed char +#define GENERIC_B_TYPE unsigned int +#define GENERIC_B_TYPE_UNSIGNED 1 +#define GENERIC_C_TYPE unsigned int +#define GENERIC_BIT_OPERATIONS 1 +#define TRAP_DIV_ZERO 1 +#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) +#define POW_RESULT_TYPE double +#define MOD_FUNCTION(a,b) ((a) % (b)) +#define GENERIC_COPY_FUNCTION copy_char_to_uint +#define GENERIC_CONVERT_FUNCTION char_to_uint +#include "slarith.inc" + +/* (signed char, long) */ +#if LONG_IS_NOT_INT + #define char_long_bin_op NULL + #define GENERIC_A_TYPE signed char + #define GENERIC_B_TYPE long + #define GENERIC_C_TYPE long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_char_to_long + #define GENERIC_CONVERT_FUNCTION char_to_long + #include "slarith.inc" +#else + #define char_long_bin_op char_int_bin_op + #define copy_char_to_long copy_char_to_int + #define char_to_long char_to_int +#endif /* LONG_IS_NOT_INT */ + +/* (signed char, unsigned long) */ +#if LONG_IS_NOT_INT + #define char_ulong_bin_op NULL + #define GENERIC_A_TYPE signed char + #define GENERIC_B_TYPE unsigned long + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_char_to_ulong + #define GENERIC_CONVERT_FUNCTION char_to_ulong + #include "slarith.inc" +#else + #define char_ulong_bin_op char_uint_bin_op + #define copy_char_to_ulong copy_char_to_uint + #define char_to_ulong char_to_uint +#endif /* LONG_IS_NOT_INT */ + +/* (signed char, long long) */ +#if defined(HAVE_LONG_LONG) + #if LLONG_IS_NOT_LONG + #define char_llong_bin_op NULL + #define GENERIC_A_TYPE signed char + #define GENERIC_B_TYPE long long + #define GENERIC_C_TYPE long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_char_to_llong + #define GENERIC_CONVERT_FUNCTION char_to_llong + #include "slarith.inc" + #else + #define char_llong_bin_op char_long_bin_op + #define copy_char_to_llong copy_char_to_long + #define char_to_llong char_to_long + #endif /* LLONG_IS_NOT_LONG */ #endif /* defined(HAVE_LONG_LONG) */ -#if SLANG_HAS_FLOAT -DEFUN_1(copy_int_to_float,int,float) -DEFUN_2(int_to_float,int,float,copy_int_to_float) -#endif /* SLANG_HAS_FLOAT */ -#if SLANG_HAS_FLOAT -DEFUN_1(copy_int_to_double,int,double) -DEFUN_2(int_to_double,int,double,copy_int_to_double) -#endif /* SLANG_HAS_FLOAT */ -#if defined(HAVE_LONG_DOUBLE) -DEFUN_1(copy_int_to_ldouble,int,long double) -DEFUN_2(int_to_ldouble,int,long double,copy_int_to_ldouble) -#endif /* defined(HAVE_LONG_DOUBLE) */ -#if SLANG_HAS_FLOAT -TO_DOUBLE_FUN(int_to_one_double,int) -#endif -/* ------------ unsigned int ---------- */ -DEFUN_1(copy_uint_to_char,unsigned int,signed char) -#define uint_to_char NULL -DEFUN_1(copy_uint_to_uchar,unsigned int,unsigned char) -#define uint_to_uchar NULL -DEFUN_1(copy_uint_to_short,unsigned int,short) -#define uint_to_short NULL -DEFUN_1(copy_uint_to_ushort,unsigned int,unsigned short) -#define uint_to_ushort NULL -#define copy_uint_to_int copy_int_to_int -#define uint_to_int NULL -#define copy_uint_to_uint copy_int_to_int -#define uint_to_uint NULL -#if LONG_IS_INT -# define copy_uint_to_long copy_uint_to_int -#else -DEFUN_1(copy_uint_to_long,unsigned int,long) -#endif -#if LONG_IS_INT -# define uint_to_long uint_to_int -#else -DEFUN_2(uint_to_long,unsigned int,long,copy_uint_to_long) -#endif -#if LONG_IS_INT -# define copy_uint_to_ulong copy_uint_to_uint -#else -DEFUN_1(copy_uint_to_ulong,unsigned int,unsigned long) -#endif -#if LONG_IS_INT -# define uint_to_ulong uint_to_uint -#else -DEFUN_2(uint_to_ulong,unsigned int,unsigned long,copy_uint_to_ulong) -#endif -#if defined(HAVE_LONG_LONG) -DEFUN_1(copy_uint_to_llong,unsigned int,long long) -DEFUN_2(uint_to_llong,unsigned int,long long,copy_uint_to_llong) -#endif /* defined(HAVE_LONG_LONG) */ -#if defined(HAVE_LONG_LONG) -DEFUN_1(copy_uint_to_ullong,unsigned int,unsigned long long) -DEFUN_2(uint_to_ullong,unsigned int,unsigned long long,copy_uint_to_ullong) +/* (signed char, unsigned long long) */ +#if defined(HAVE_LONG_LONG) + #if LLONG_IS_NOT_LONG + #define char_ullong_bin_op NULL + #define GENERIC_A_TYPE signed char + #define GENERIC_B_TYPE unsigned long long + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_char_to_ullong + #define GENERIC_CONVERT_FUNCTION char_to_ullong + #include "slarith.inc" + #else + #define char_ullong_bin_op char_ulong_bin_op + #define copy_char_to_ullong copy_char_to_ulong + #define char_to_ullong char_to_ulong + #endif /* LLONG_IS_NOT_LONG */ #endif /* defined(HAVE_LONG_LONG) */ + +/* (signed char, float) */ #if SLANG_HAS_FLOAT -DEFUN_1(copy_uint_to_float,unsigned int,float) -DEFUN_2(uint_to_float,unsigned int,float,copy_uint_to_float) + #define char_float_bin_op NULL + #define GENERIC_A_TYPE signed char + #define GENERIC_B_TYPE float + #define GENERIC_C_TYPE float + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE float + #define MOD_FUNCTION(a,b) (float)fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_char_to_float + #define GENERIC_CONVERT_FUNCTION char_to_float + #include "slarith.inc" #endif /* SLANG_HAS_FLOAT */ + +/* (signed char, double) */ #if SLANG_HAS_FLOAT -DEFUN_1(copy_uint_to_double,unsigned int,double) -DEFUN_2(uint_to_double,unsigned int,double,copy_uint_to_double) + #define GENERIC_BINARY_FUNCTION char_double_bin_op + #define GENERIC_A_TYPE signed char + #define GENERIC_B_TYPE double + #define GENERIC_C_TYPE double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_char_to_double + #define GENERIC_CONVERT_FUNCTION char_to_double + #include "slarith.inc" #endif /* SLANG_HAS_FLOAT */ -#if defined(HAVE_LONG_DOUBLE) -DEFUN_1(copy_uint_to_ldouble,unsigned int,long double) -DEFUN_2(uint_to_ldouble,unsigned int,long double,copy_uint_to_ldouble) -#endif /* defined(HAVE_LONG_DOUBLE) */ -#if SLANG_HAS_FLOAT -TO_DOUBLE_FUN(uint_to_one_double,unsigned int) -#endif -/* ------------ long ---------- */ -#if LONG_IS_INT -# define copy_long_to_char copy_int_to_char -#else -DEFUN_1(copy_long_to_char,long,signed char) -#endif -#define long_to_char NULL -#if LONG_IS_INT -# define copy_long_to_uchar copy_int_to_uchar -#else -DEFUN_1(copy_long_to_uchar,long,unsigned char) -#endif -#define long_to_uchar NULL -#if LONG_IS_INT -# define copy_long_to_short copy_int_to_short -#else -DEFUN_1(copy_long_to_short,long,short) -#endif -#define long_to_short NULL -#if LONG_IS_INT -# define copy_long_to_ushort copy_int_to_ushort -#else -DEFUN_1(copy_long_to_ushort,long,unsigned short) -#endif -#define long_to_ushort NULL -#if LONG_IS_INT -# define copy_long_to_int copy_int_to_int -#else -DEFUN_1(copy_long_to_int,long,int) -#endif -#define long_to_int NULL -#if LONG_IS_INT -# define copy_long_to_uint copy_int_to_uint -#else -DEFUN_1(copy_long_to_uint,long,unsigned int) -#endif -#define long_to_uint NULL -#if LONG_IS_INT -# define copy_long_to_long copy_long_to_int -#else -DEFUN_1(copy_long_to_long,long,long) -#endif -#define long_to_long NULL -#define copy_long_to_ulong copy_long_to_long -#define long_to_ulong NULL -#if defined(HAVE_LONG_LONG) -#if LONG_IS_INT -# define copy_long_to_llong copy_int_to_llong -#else -DEFUN_1(copy_long_to_llong,long,long long) -#endif -#if LONG_IS_INT -# define long_to_llong int_to_llong -#else -DEFUN_2(long_to_llong,long,long long,copy_long_to_llong) -#endif -#endif /* defined(HAVE_LONG_LONG) */ -#if defined(HAVE_LONG_LONG) -#if LONG_IS_INT -# define copy_long_to_ullong copy_int_to_ullong -#else -DEFUN_1(copy_long_to_ullong,long,unsigned long long) -#endif -#if LONG_IS_INT -# define long_to_ullong int_to_ullong -#else -DEFUN_2(long_to_ullong,long,unsigned long long,copy_long_to_ullong) -#endif -#endif /* defined(HAVE_LONG_LONG) */ -#if SLANG_HAS_FLOAT -#if LONG_IS_INT -# define copy_long_to_float copy_int_to_float -#else -DEFUN_1(copy_long_to_float,long,float) -#endif -#if LONG_IS_INT -# define long_to_float int_to_float -#else -DEFUN_2(long_to_float,long,float,copy_long_to_float) -#endif -#endif /* SLANG_HAS_FLOAT */ -#if SLANG_HAS_FLOAT -#if LONG_IS_INT -# define copy_long_to_double copy_int_to_double -#else -DEFUN_1(copy_long_to_double,long,double) -#endif -#if LONG_IS_INT -# define long_to_double int_to_double -#else -DEFUN_2(long_to_double,long,double,copy_long_to_double) -#endif -#endif /* SLANG_HAS_FLOAT */ +/* (signed char, long double) */ #if defined(HAVE_LONG_DOUBLE) -#if LONG_IS_INT -# define copy_long_to_ldouble copy_int_to_ldouble -#else -DEFUN_1(copy_long_to_ldouble,long,long double) -#endif -#if LONG_IS_INT -# define long_to_ldouble int_to_ldouble -#else -DEFUN_2(long_to_ldouble,long,long double,copy_long_to_ldouble) -#endif + #define char_ldouble_bin_op NULL + #define GENERIC_A_TYPE signed char + #define GENERIC_B_TYPE long double + #define GENERIC_C_TYPE long double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) lpow((long double)(a),(long double)(b)) + #define POW_RESULT_TYPE long double + #define MOD_FUNCTION(a,b) fmodl((a),(b)) + #define GENERIC_COPY_FUNCTION copy_char_to_ldouble + #define GENERIC_CONVERT_FUNCTION char_to_ldouble + #include "slarith.inc" #endif /* defined(HAVE_LONG_DOUBLE) */ -#if SLANG_HAS_FLOAT -TO_DOUBLE_FUN(long_to_one_double,long) -#endif -/* ------------ unsigned long ---------- */ -#if LONG_IS_INT -# define copy_ulong_to_char copy_uint_to_char -#else -DEFUN_1(copy_ulong_to_char,unsigned long,signed char) -#endif -#define ulong_to_char NULL -#if LONG_IS_INT -# define copy_ulong_to_uchar copy_uint_to_uchar -#else -DEFUN_1(copy_ulong_to_uchar,unsigned long,unsigned char) -#endif -#define ulong_to_uchar NULL -#if LONG_IS_INT -# define copy_ulong_to_short copy_uint_to_short -#else -DEFUN_1(copy_ulong_to_short,unsigned long,short) -#endif -#define ulong_to_short NULL -#if LONG_IS_INT -# define copy_ulong_to_ushort copy_uint_to_ushort -#else -DEFUN_1(copy_ulong_to_ushort,unsigned long,unsigned short) -#endif -#define ulong_to_ushort NULL -#if LONG_IS_INT -# define copy_ulong_to_int copy_uint_to_int -#else -DEFUN_1(copy_ulong_to_int,unsigned long,int) -#endif -#define ulong_to_int NULL -#if LONG_IS_INT -# define copy_ulong_to_uint copy_uint_to_uint -#else -DEFUN_1(copy_ulong_to_uint,unsigned long,unsigned int) -#endif -#define ulong_to_uint NULL -#define copy_ulong_to_long copy_long_to_long -#define ulong_to_long NULL -#define copy_ulong_to_ulong copy_long_to_long -#define ulong_to_ulong NULL -#if defined(HAVE_LONG_LONG) -#if LONG_IS_INT -# define copy_ulong_to_llong copy_uint_to_llong -#else -DEFUN_1(copy_ulong_to_llong,unsigned long,long long) -#endif -#if LONG_IS_INT -# define ulong_to_llong uint_to_llong -#else -DEFUN_2(ulong_to_llong,unsigned long,long long,copy_ulong_to_llong) -#endif -#endif /* defined(HAVE_LONG_LONG) */ -#if defined(HAVE_LONG_LONG) -#if LONG_IS_INT -# define copy_ulong_to_ullong copy_uint_to_ullong -#else -DEFUN_1(copy_ulong_to_ullong,unsigned long,unsigned long long) -#endif -#if LONG_IS_INT -# define ulong_to_ullong uint_to_ullong -#else -DEFUN_2(ulong_to_ullong,unsigned long,unsigned long long,copy_ulong_to_ullong) -#endif -#endif /* defined(HAVE_LONG_LONG) */ -#if SLANG_HAS_FLOAT -#if LONG_IS_INT -# define copy_ulong_to_float copy_uint_to_float -#else -DEFUN_1(copy_ulong_to_float,unsigned long,float) -#endif -#if LONG_IS_INT -# define ulong_to_float uint_to_float -#else -DEFUN_2(ulong_to_float,unsigned long,float,copy_ulong_to_float) -#endif -#endif /* SLANG_HAS_FLOAT */ -#if SLANG_HAS_FLOAT -#if LONG_IS_INT -# define copy_ulong_to_double copy_uint_to_double -#else -DEFUN_1(copy_ulong_to_double,unsigned long,double) -#endif -#if LONG_IS_INT -# define ulong_to_double uint_to_double -#else -DEFUN_2(ulong_to_double,unsigned long,double,copy_ulong_to_double) -#endif -#endif /* SLANG_HAS_FLOAT */ -#if defined(HAVE_LONG_DOUBLE) -#if LONG_IS_INT -# define copy_ulong_to_ldouble copy_uint_to_ldouble -#else -DEFUN_1(copy_ulong_to_ldouble,unsigned long,long double) -#endif -#if LONG_IS_INT -# define ulong_to_ldouble uint_to_ldouble -#else -DEFUN_2(ulong_to_ldouble,unsigned long,long double,copy_ulong_to_ldouble) -#endif -#endif /* defined(HAVE_LONG_DOUBLE) */ -#if SLANG_HAS_FLOAT -TO_DOUBLE_FUN(ulong_to_one_double,unsigned long) -#endif -/* ------------ long long ---------- */ +/* unsigned char */ +/* (unsigned char, signed char) */ +#define uchar_char_bin_op NULL +#define GENERIC_A_TYPE unsigned char +#define GENERIC_A_TYPE_UNSIGNED 1 +#define GENERIC_B_TYPE signed char +#define GENERIC_C_TYPE int +#define GENERIC_BIT_OPERATIONS 1 +#define TRAP_DIV_ZERO 1 +#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) +#define POW_RESULT_TYPE double +#define MOD_FUNCTION(a,b) ((a) % (b)) +#define copy_uchar_to_char copy_char_to_char +#define uchar_to_char uchar_to_int +#include "slarith.inc" + +/* (unsigned char, unsigned char) */ +#define GENERIC_BINARY_FUNCTION uchar_uchar_bin_op +#define GENERIC_A_TYPE unsigned char +#define GENERIC_A_TYPE_UNSIGNED 1 +#define GENERIC_B_TYPE unsigned char +#define GENERIC_B_TYPE_UNSIGNED 1 +#define GENERIC_C_TYPE int +#define GENERIC_BIT_OPERATIONS 1 +#define TRAP_DIV_ZERO 1 +#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) +#define POW_RESULT_TYPE double +#define MOD_FUNCTION(a,b) ((a) % (b)) +#define uchar_uchar_scalar_bin_op int_int_scalar_bin_op +#define GENERIC_UNARY_FUNCTION uchar_unary_op +#define ABS_FUNCTION(a) (a) +#define CMP_FUNCTION uchar_cmp_function +#define TO_BINARY_FUNCTION uchar_to_binary +#define TO_DOUBLE_FUNCTION uchar_to_one_double +#define copy_uchar_to_uchar copy_char_to_char +#define uchar_to_uchar uchar_to_int +#include "slarith.inc" + +/* (unsigned char, short) */ +#if SHORT_IS_NOT_INT + #define uchar_short_bin_op NULL + #define GENERIC_A_TYPE unsigned char + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE short + #define GENERIC_C_TYPE int + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_uchar_to_short + #define uchar_to_short uchar_to_int + #include "slarith.inc" +#else + #define uchar_short_bin_op uchar_int_bin_op + #define copy_uchar_to_short copy_uchar_to_int + #define uchar_to_short uchar_to_int +#endif /* SHORT_IS_NOT_INT */ + +/* (unsigned char, unsigned short) */ +#if SHORT_IS_NOT_INT + #define uchar_ushort_bin_op NULL + #define GENERIC_A_TYPE unsigned char + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE unsigned short + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE int + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_uchar_to_ushort + #define uchar_to_ushort uchar_to_int + #include "slarith.inc" +#else + #define uchar_ushort_bin_op uchar_uint_bin_op + #define copy_uchar_to_ushort copy_uchar_to_uint + #define uchar_to_ushort uchar_to_uint +#endif /* SHORT_IS_NOT_INT */ + +/* (unsigned char, int) */ +#define GENERIC_BINARY_FUNCTION uchar_int_bin_op +#define GENERIC_A_TYPE unsigned char +#define GENERIC_A_TYPE_UNSIGNED 1 +#define GENERIC_B_TYPE int +#define GENERIC_C_TYPE int +#define GENERIC_BIT_OPERATIONS 1 +#define TRAP_DIV_ZERO 1 +#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) +#define POW_RESULT_TYPE double +#define MOD_FUNCTION(a,b) ((a) % (b)) +#define GENERIC_COPY_FUNCTION copy_uchar_to_int +#define GENERIC_CONVERT_FUNCTION uchar_to_int +#include "slarith.inc" + +/* (unsigned char, unsigned int) */ +#define uchar_uint_bin_op NULL +#define GENERIC_A_TYPE unsigned char +#define GENERIC_A_TYPE_UNSIGNED 1 +#define GENERIC_B_TYPE unsigned int +#define GENERIC_B_TYPE_UNSIGNED 1 +#define GENERIC_C_TYPE unsigned int +#define GENERIC_BIT_OPERATIONS 1 +#define TRAP_DIV_ZERO 1 +#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) +#define POW_RESULT_TYPE double +#define MOD_FUNCTION(a,b) ((a) % (b)) +#define GENERIC_COPY_FUNCTION copy_uchar_to_uint +#define GENERIC_CONVERT_FUNCTION uchar_to_uint +#include "slarith.inc" + +/* (unsigned char, long) */ +#if LONG_IS_NOT_INT + #define uchar_long_bin_op NULL + #define GENERIC_A_TYPE unsigned char + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE long + #define GENERIC_C_TYPE long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_uchar_to_long + #define GENERIC_CONVERT_FUNCTION uchar_to_long + #include "slarith.inc" +#else + #define uchar_long_bin_op uchar_int_bin_op + #define copy_uchar_to_long copy_uchar_to_int + #define uchar_to_long uchar_to_int +#endif /* LONG_IS_NOT_INT */ + +/* (unsigned char, unsigned long) */ +#if LONG_IS_NOT_INT + #define uchar_ulong_bin_op NULL + #define GENERIC_A_TYPE unsigned char + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE unsigned long + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_uchar_to_ulong + #define GENERIC_CONVERT_FUNCTION uchar_to_ulong + #include "slarith.inc" +#else + #define uchar_ulong_bin_op uchar_uint_bin_op + #define copy_uchar_to_ulong copy_uchar_to_uint + #define uchar_to_ulong uchar_to_uint +#endif /* LONG_IS_NOT_INT */ + +/* (unsigned char, long long) */ +#if defined(HAVE_LONG_LONG) + #if LLONG_IS_NOT_LONG + #define uchar_llong_bin_op NULL + #define GENERIC_A_TYPE unsigned char + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE long long + #define GENERIC_C_TYPE long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_uchar_to_llong + #define GENERIC_CONVERT_FUNCTION uchar_to_llong + #include "slarith.inc" + #else + #define uchar_llong_bin_op uchar_long_bin_op + #define copy_uchar_to_llong copy_uchar_to_long + #define uchar_to_llong uchar_to_long + #endif /* LLONG_IS_NOT_LONG */ +#endif /* defined(HAVE_LONG_LONG) */ + +/* (unsigned char, unsigned long long) */ #if defined(HAVE_LONG_LONG) -DEFUN_1(copy_llong_to_char,long long,signed char) -#define llong_to_char NULL -DEFUN_1(copy_llong_to_uchar,long long,unsigned char) -#define llong_to_uchar NULL -DEFUN_1(copy_llong_to_short,long long,short) -#define llong_to_short NULL -DEFUN_1(copy_llong_to_ushort,long long,unsigned short) -#define llong_to_ushort NULL -DEFUN_1(copy_llong_to_int,long long,int) -#define llong_to_int NULL -DEFUN_1(copy_llong_to_uint,long long,unsigned int) -#define llong_to_uint NULL -#if LONG_IS_INT -# define copy_llong_to_long copy_llong_to_int -#else -DEFUN_1(copy_llong_to_long,long long,long) -#endif -#define llong_to_long NULL -#if LONG_IS_INT -# define copy_llong_to_ulong copy_llong_to_uint -#else -DEFUN_1(copy_llong_to_ulong,long long,unsigned long) -#endif -#define llong_to_ulong NULL -#if defined(HAVE_LONG_LONG) -DEFUN_1(copy_llong_to_llong,long long,long long) -#define llong_to_llong NULL -#endif /* defined(HAVE_LONG_LONG) */ -#if defined(HAVE_LONG_LONG) -#define copy_llong_to_ullong copy_llong_to_llong -#define llong_to_ullong NULL + #if LLONG_IS_NOT_LONG + #define uchar_ullong_bin_op NULL + #define GENERIC_A_TYPE unsigned char + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE unsigned long long + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_uchar_to_ullong + #define GENERIC_CONVERT_FUNCTION uchar_to_ullong + #include "slarith.inc" + #else + #define uchar_ullong_bin_op uchar_ulong_bin_op + #define copy_uchar_to_ullong copy_uchar_to_ulong + #define uchar_to_ullong uchar_to_ulong + #endif /* LLONG_IS_NOT_LONG */ #endif /* defined(HAVE_LONG_LONG) */ + +/* (unsigned char, float) */ #if SLANG_HAS_FLOAT -DEFUN_1(copy_llong_to_float,long long,float) -DEFUN_2(llong_to_float,long long,float,copy_llong_to_float) + #define uchar_float_bin_op NULL + #define GENERIC_A_TYPE unsigned char + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE float + #define GENERIC_C_TYPE float + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE float + #define MOD_FUNCTION(a,b) (float)fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_uchar_to_float + #define GENERIC_CONVERT_FUNCTION uchar_to_float + #include "slarith.inc" #endif /* SLANG_HAS_FLOAT */ + +/* (unsigned char, double) */ #if SLANG_HAS_FLOAT -DEFUN_1(copy_llong_to_double,long long,double) -DEFUN_2(llong_to_double,long long,double,copy_llong_to_double) + #define GENERIC_BINARY_FUNCTION uchar_double_bin_op + #define GENERIC_A_TYPE unsigned char + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE double + #define GENERIC_C_TYPE double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_uchar_to_double + #define GENERIC_CONVERT_FUNCTION uchar_to_double + #include "slarith.inc" #endif /* SLANG_HAS_FLOAT */ + +/* (unsigned char, long double) */ #if defined(HAVE_LONG_DOUBLE) -DEFUN_1(copy_llong_to_ldouble,long long,long double) -DEFUN_2(llong_to_ldouble,long long,long double,copy_llong_to_ldouble) + #define uchar_ldouble_bin_op NULL + #define GENERIC_A_TYPE unsigned char + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE long double + #define GENERIC_C_TYPE long double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) lpow((long double)(a),(long double)(b)) + #define POW_RESULT_TYPE long double + #define MOD_FUNCTION(a,b) fmodl((a),(b)) + #define GENERIC_COPY_FUNCTION copy_uchar_to_ldouble + #define GENERIC_CONVERT_FUNCTION uchar_to_ldouble + #include "slarith.inc" #endif /* defined(HAVE_LONG_DOUBLE) */ -#if SLANG_HAS_FLOAT -TO_DOUBLE_FUN(llong_to_one_double,long long) -#endif -#endif /* defined(HAVE_LONG_LONG) */ -/* ------------ unsigned long long ---------- */ -#if defined(HAVE_LONG_LONG) -DEFUN_1(copy_ullong_to_char,unsigned long long,signed char) -#define ullong_to_char NULL -DEFUN_1(copy_ullong_to_uchar,unsigned long long,unsigned char) -#define ullong_to_uchar NULL -DEFUN_1(copy_ullong_to_short,unsigned long long,short) -#define ullong_to_short NULL -DEFUN_1(copy_ullong_to_ushort,unsigned long long,unsigned short) -#define ullong_to_ushort NULL -DEFUN_1(copy_ullong_to_int,unsigned long long,int) -#define ullong_to_int NULL -DEFUN_1(copy_ullong_to_uint,unsigned long long,unsigned int) -#define ullong_to_uint NULL -#if LONG_IS_INT -# define copy_ullong_to_long copy_ullong_to_int + +/* short */ +#if SHORT_IS_NOT_INT +/* (short, signed char) */ + #define short_char_bin_op NULL + #define GENERIC_A_TYPE short + #define GENERIC_B_TYPE signed char + #define GENERIC_C_TYPE int + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_short_to_char + #define short_to_char NULL + #include "slarith.inc" + +/* (short, unsigned char) */ + #define short_uchar_bin_op NULL + #define GENERIC_A_TYPE short + #define GENERIC_B_TYPE unsigned char + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE int + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_short_to_uchar + #define short_to_uchar NULL + #include "slarith.inc" + +/* (short, short) */ + #define GENERIC_BINARY_FUNCTION short_short_bin_op + #define GENERIC_A_TYPE short + #define GENERIC_B_TYPE short + #define GENERIC_C_TYPE int + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define short_short_scalar_bin_op int_int_scalar_bin_op + #define GENERIC_UNARY_FUNCTION short_unary_op + #define ABS_FUNCTION(a) abs(a) + #define CMP_FUNCTION short_cmp_function + #define TO_DOUBLE_FUNCTION short_to_one_double + #define GENERIC_COPY_FUNCTION copy_short_to_short + #define short_to_short short_to_int + #include "slarith.inc" + +/* (short, unsigned short) */ + #if SHORT_IS_NOT_INT + #define short_ushort_bin_op NULL + #define GENERIC_A_TYPE short + #define GENERIC_B_TYPE unsigned short + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE int + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define copy_short_to_ushort copy_short_to_short + #define short_to_ushort short_to_int + #include "slarith.inc" + #else + #define short_ushort_bin_op short_uint_bin_op + #define copy_short_to_ushort copy_short_to_uint + #define short_to_ushort short_to_uint + #endif /* SHORT_IS_NOT_INT */ + +/* (short, int) */ + #define GENERIC_BINARY_FUNCTION short_int_bin_op + #define GENERIC_A_TYPE short + #define GENERIC_B_TYPE int + #define GENERIC_C_TYPE int + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_short_to_int + #define GENERIC_CONVERT_FUNCTION short_to_int + #include "slarith.inc" + +/* (short, unsigned int) */ + #define short_uint_bin_op NULL + #define GENERIC_A_TYPE short + #define GENERIC_B_TYPE unsigned int + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned int + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_short_to_uint + #define GENERIC_CONVERT_FUNCTION short_to_uint + #include "slarith.inc" + +/* (short, long) */ + #if LONG_IS_NOT_INT + #define short_long_bin_op NULL + #define GENERIC_A_TYPE short + #define GENERIC_B_TYPE long + #define GENERIC_C_TYPE long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_short_to_long + #define GENERIC_CONVERT_FUNCTION short_to_long + #include "slarith.inc" + #else + #define short_long_bin_op short_int_bin_op + #define copy_short_to_long copy_short_to_int + #define short_to_long short_to_int + #endif /* LONG_IS_NOT_INT */ + +/* (short, unsigned long) */ + #if LONG_IS_NOT_INT + #define short_ulong_bin_op NULL + #define GENERIC_A_TYPE short + #define GENERIC_B_TYPE unsigned long + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_short_to_ulong + #define GENERIC_CONVERT_FUNCTION short_to_ulong + #include "slarith.inc" + #else + #define short_ulong_bin_op short_uint_bin_op + #define copy_short_to_ulong copy_short_to_uint + #define short_to_ulong short_to_uint + #endif /* LONG_IS_NOT_INT */ + +/* (short, long long) */ + #if defined(HAVE_LONG_LONG) + #if LLONG_IS_NOT_LONG + #define short_llong_bin_op NULL + #define GENERIC_A_TYPE short + #define GENERIC_B_TYPE long long + #define GENERIC_C_TYPE long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_short_to_llong + #define GENERIC_CONVERT_FUNCTION short_to_llong + #include "slarith.inc" + #else + #define short_llong_bin_op short_long_bin_op + #define copy_short_to_llong copy_short_to_long + #define short_to_llong short_to_long + #endif /* LLONG_IS_NOT_LONG */ + #endif /* defined(HAVE_LONG_LONG) */ + +/* (short, unsigned long long) */ + #if defined(HAVE_LONG_LONG) + #if LLONG_IS_NOT_LONG + #define short_ullong_bin_op NULL + #define GENERIC_A_TYPE short + #define GENERIC_B_TYPE unsigned long long + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_short_to_ullong + #define GENERIC_CONVERT_FUNCTION short_to_ullong + #include "slarith.inc" + #else + #define short_ullong_bin_op short_ulong_bin_op + #define copy_short_to_ullong copy_short_to_ulong + #define short_to_ullong short_to_ulong + #endif /* LLONG_IS_NOT_LONG */ + #endif /* defined(HAVE_LONG_LONG) */ + +/* (short, float) */ + #if SLANG_HAS_FLOAT + #define short_float_bin_op NULL + #define GENERIC_A_TYPE short + #define GENERIC_B_TYPE float + #define GENERIC_C_TYPE float + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE float + #define MOD_FUNCTION(a,b) (float)fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_short_to_float + #define GENERIC_CONVERT_FUNCTION short_to_float + #include "slarith.inc" + #endif /* SLANG_HAS_FLOAT */ + +/* (short, double) */ + #if SLANG_HAS_FLOAT + #define GENERIC_BINARY_FUNCTION short_double_bin_op + #define GENERIC_A_TYPE short + #define GENERIC_B_TYPE double + #define GENERIC_C_TYPE double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_short_to_double + #define GENERIC_CONVERT_FUNCTION short_to_double + #include "slarith.inc" + #endif /* SLANG_HAS_FLOAT */ + +/* (short, long double) */ + #if defined(HAVE_LONG_DOUBLE) + #define short_ldouble_bin_op NULL + #define GENERIC_A_TYPE short + #define GENERIC_B_TYPE long double + #define GENERIC_C_TYPE long double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) lpow((long double)(a),(long double)(b)) + #define POW_RESULT_TYPE long double + #define MOD_FUNCTION(a,b) fmodl((a),(b)) + #define GENERIC_COPY_FUNCTION copy_short_to_ldouble + #define GENERIC_CONVERT_FUNCTION short_to_ldouble + #include "slarith.inc" + #endif /* defined(HAVE_LONG_DOUBLE) */ + #else -DEFUN_1(copy_ullong_to_long,unsigned long long,long) -#endif -#define ullong_to_long NULL -#if LONG_IS_INT -# define copy_ullong_to_ulong copy_ullong_to_uint + #define short_char_bin_op int_char_bin_op + #define short_char_scalar_bin_op int_char_scalar_bin_op + #define copy_short_to_char copy_int_to_char + #define short_to_char int_to_char + #define short_uchar_bin_op int_uchar_bin_op + #define short_uchar_scalar_bin_op int_uchar_scalar_bin_op + #define copy_short_to_uchar copy_int_to_uchar + #define short_to_uchar int_to_uchar + #define short_short_bin_op int_int_bin_op + #define short_short_scalar_bin_op int_int_scalar_bin_op + #define copy_short_to_short copy_int_to_int + #define short_to_short int_to_int + #define short_ushort_bin_op int_ushort_bin_op + #define short_ushort_scalar_bin_op int_ushort_scalar_bin_op + #define copy_short_to_ushort copy_int_to_ushort + #define short_to_ushort int_to_ushort + #define short_int_bin_op int_int_bin_op + #define short_int_scalar_bin_op int_int_scalar_bin_op + #define copy_short_to_int copy_int_to_int + #define short_to_int int_to_int + #define short_uint_bin_op int_uint_bin_op + #define short_uint_scalar_bin_op int_uint_scalar_bin_op + #define copy_short_to_uint copy_int_to_uint + #define short_to_uint int_to_uint + #define short_long_bin_op int_long_bin_op + #define short_long_scalar_bin_op int_long_scalar_bin_op + #define copy_short_to_long copy_int_to_long + #define short_to_long int_to_long + #define short_ulong_bin_op int_ulong_bin_op + #define short_ulong_scalar_bin_op int_ulong_scalar_bin_op + #define copy_short_to_ulong copy_int_to_ulong + #define short_to_ulong int_to_ulong + #define short_llong_bin_op int_llong_bin_op + #define short_llong_scalar_bin_op int_llong_scalar_bin_op + #define copy_short_to_llong copy_int_to_llong + #define short_to_llong int_to_llong + #define short_ullong_bin_op int_ullong_bin_op + #define short_ullong_scalar_bin_op int_ullong_scalar_bin_op + #define copy_short_to_ullong copy_int_to_ullong + #define short_to_ullong int_to_ullong + #define short_float_bin_op int_float_bin_op + #define short_float_scalar_bin_op int_float_scalar_bin_op + #define copy_short_to_float copy_int_to_float + #define short_to_float int_to_float + #define short_double_bin_op int_double_bin_op + #define short_double_scalar_bin_op int_double_scalar_bin_op + #define copy_short_to_double copy_int_to_double + #define short_to_double int_to_double + #define short_ldouble_bin_op int_ldouble_bin_op + #define short_ldouble_scalar_bin_op int_ldouble_scalar_bin_op + #define copy_short_to_ldouble copy_int_to_ldouble + #define short_to_ldouble int_to_ldouble + #define short_unary_op int_unary_op + #define short_cmp_function int_cmp_function + #define short_to_one_double int_to_one_double +#endif /* SHORT_IS_NOT_INT */ + +/* unsigned short */ +#if SHORT_IS_NOT_INT +/* (unsigned short, signed char) */ + #define ushort_char_bin_op NULL + #define GENERIC_A_TYPE unsigned short + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE signed char + #define GENERIC_C_TYPE int + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_ushort_to_char + #define ushort_to_char NULL + #include "slarith.inc" + +/* (unsigned short, unsigned char) */ + #define ushort_uchar_bin_op NULL + #define GENERIC_A_TYPE unsigned short + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE unsigned char + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE int + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_ushort_to_uchar + #define ushort_to_uchar NULL + #include "slarith.inc" + +/* (unsigned short, short) */ + #if SHORT_IS_NOT_INT + #define ushort_short_bin_op NULL + #define GENERIC_A_TYPE unsigned short + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE short + #define GENERIC_C_TYPE int + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define copy_ushort_to_short copy_short_to_short + #define ushort_to_short ushort_to_int + #include "slarith.inc" + #else + #define ushort_short_bin_op ushort_int_bin_op + #define copy_ushort_to_short copy_ushort_to_int + #define ushort_to_short ushort_to_int + #endif /* SHORT_IS_NOT_INT */ + +/* (unsigned short, unsigned short) */ + #define GENERIC_BINARY_FUNCTION ushort_ushort_bin_op + #define GENERIC_A_TYPE unsigned short + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE unsigned short + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE int + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define ushort_ushort_scalar_bin_op int_int_scalar_bin_op + #define GENERIC_UNARY_FUNCTION ushort_unary_op + #define ABS_FUNCTION(a) (a) + #define CMP_FUNCTION ushort_cmp_function + #define TO_BINARY_FUNCTION ushort_to_binary + #define TO_DOUBLE_FUNCTION ushort_to_one_double + #define copy_ushort_to_ushort copy_short_to_short + #define ushort_to_ushort ushort_to_int + #include "slarith.inc" + +/* (unsigned short, int) */ + #define GENERIC_BINARY_FUNCTION ushort_int_bin_op + #define GENERIC_A_TYPE unsigned short + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE int + #define GENERIC_C_TYPE int + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_ushort_to_int + #define GENERIC_CONVERT_FUNCTION ushort_to_int + #include "slarith.inc" + +/* (unsigned short, unsigned int) */ + #define ushort_uint_bin_op NULL + #define GENERIC_A_TYPE unsigned short + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE unsigned int + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned int + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_ushort_to_uint + #define GENERIC_CONVERT_FUNCTION ushort_to_uint + #include "slarith.inc" + +/* (unsigned short, long) */ + #if LONG_IS_NOT_INT + #define ushort_long_bin_op NULL + #define GENERIC_A_TYPE unsigned short + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE long + #define GENERIC_C_TYPE long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_ushort_to_long + #define GENERIC_CONVERT_FUNCTION ushort_to_long + #include "slarith.inc" + #else + #define ushort_long_bin_op ushort_int_bin_op + #define copy_ushort_to_long copy_ushort_to_int + #define ushort_to_long ushort_to_int + #endif /* LONG_IS_NOT_INT */ + +/* (unsigned short, unsigned long) */ + #if LONG_IS_NOT_INT + #define ushort_ulong_bin_op NULL + #define GENERIC_A_TYPE unsigned short + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE unsigned long + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_ushort_to_ulong + #define GENERIC_CONVERT_FUNCTION ushort_to_ulong + #include "slarith.inc" + #else + #define ushort_ulong_bin_op ushort_uint_bin_op + #define copy_ushort_to_ulong copy_ushort_to_uint + #define ushort_to_ulong ushort_to_uint + #endif /* LONG_IS_NOT_INT */ + +/* (unsigned short, long long) */ + #if defined(HAVE_LONG_LONG) + #if LLONG_IS_NOT_LONG + #define ushort_llong_bin_op NULL + #define GENERIC_A_TYPE unsigned short + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE long long + #define GENERIC_C_TYPE long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_ushort_to_llong + #define GENERIC_CONVERT_FUNCTION ushort_to_llong + #include "slarith.inc" + #else + #define ushort_llong_bin_op ushort_long_bin_op + #define copy_ushort_to_llong copy_ushort_to_long + #define ushort_to_llong ushort_to_long + #endif /* LLONG_IS_NOT_LONG */ + #endif /* defined(HAVE_LONG_LONG) */ + +/* (unsigned short, unsigned long long) */ + #if defined(HAVE_LONG_LONG) + #if LLONG_IS_NOT_LONG + #define ushort_ullong_bin_op NULL + #define GENERIC_A_TYPE unsigned short + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE unsigned long long + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_ushort_to_ullong + #define GENERIC_CONVERT_FUNCTION ushort_to_ullong + #include "slarith.inc" + #else + #define ushort_ullong_bin_op ushort_ulong_bin_op + #define copy_ushort_to_ullong copy_ushort_to_ulong + #define ushort_to_ullong ushort_to_ulong + #endif /* LLONG_IS_NOT_LONG */ + #endif /* defined(HAVE_LONG_LONG) */ + +/* (unsigned short, float) */ + #if SLANG_HAS_FLOAT + #define ushort_float_bin_op NULL + #define GENERIC_A_TYPE unsigned short + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE float + #define GENERIC_C_TYPE float + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE float + #define MOD_FUNCTION(a,b) (float)fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_ushort_to_float + #define GENERIC_CONVERT_FUNCTION ushort_to_float + #include "slarith.inc" + #endif /* SLANG_HAS_FLOAT */ + +/* (unsigned short, double) */ + #if SLANG_HAS_FLOAT + #define GENERIC_BINARY_FUNCTION ushort_double_bin_op + #define GENERIC_A_TYPE unsigned short + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE double + #define GENERIC_C_TYPE double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_ushort_to_double + #define GENERIC_CONVERT_FUNCTION ushort_to_double + #include "slarith.inc" + #endif /* SLANG_HAS_FLOAT */ + +/* (unsigned short, long double) */ + #if defined(HAVE_LONG_DOUBLE) + #define ushort_ldouble_bin_op NULL + #define GENERIC_A_TYPE unsigned short + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE long double + #define GENERIC_C_TYPE long double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) lpow((long double)(a),(long double)(b)) + #define POW_RESULT_TYPE long double + #define MOD_FUNCTION(a,b) fmodl((a),(b)) + #define GENERIC_COPY_FUNCTION copy_ushort_to_ldouble + #define GENERIC_CONVERT_FUNCTION ushort_to_ldouble + #include "slarith.inc" + #endif /* defined(HAVE_LONG_DOUBLE) */ + #else -DEFUN_1(copy_ullong_to_ulong,unsigned long long,unsigned long) -#endif -#define ullong_to_ulong NULL + #define ushort_char_bin_op uint_char_bin_op + #define ushort_char_scalar_bin_op uint_char_scalar_bin_op + #define copy_ushort_to_char copy_uint_to_char + #define ushort_to_char uint_to_char + #define ushort_uchar_bin_op uint_uchar_bin_op + #define ushort_uchar_scalar_bin_op uint_uchar_scalar_bin_op + #define copy_ushort_to_uchar copy_uint_to_uchar + #define ushort_to_uchar uint_to_uchar + #define ushort_short_bin_op uint_short_bin_op + #define ushort_short_scalar_bin_op uint_short_scalar_bin_op + #define copy_ushort_to_short copy_uint_to_short + #define ushort_to_short uint_to_short + #define ushort_ushort_bin_op uint_uint_bin_op + #define ushort_ushort_scalar_bin_op uint_uint_scalar_bin_op + #define copy_ushort_to_ushort copy_uint_to_uint + #define ushort_to_ushort uint_to_uint + #define ushort_int_bin_op uint_int_bin_op + #define ushort_int_scalar_bin_op uint_int_scalar_bin_op + #define copy_ushort_to_int copy_uint_to_int + #define ushort_to_int uint_to_int + #define ushort_uint_bin_op uint_uint_bin_op + #define ushort_uint_scalar_bin_op uint_uint_scalar_bin_op + #define copy_ushort_to_uint copy_uint_to_uint + #define ushort_to_uint uint_to_uint + #define ushort_long_bin_op uint_long_bin_op + #define ushort_long_scalar_bin_op uint_long_scalar_bin_op + #define copy_ushort_to_long copy_uint_to_long + #define ushort_to_long uint_to_long + #define ushort_ulong_bin_op uint_ulong_bin_op + #define ushort_ulong_scalar_bin_op uint_ulong_scalar_bin_op + #define copy_ushort_to_ulong copy_uint_to_ulong + #define ushort_to_ulong uint_to_ulong + #define ushort_llong_bin_op uint_llong_bin_op + #define ushort_llong_scalar_bin_op uint_llong_scalar_bin_op + #define copy_ushort_to_llong copy_uint_to_llong + #define ushort_to_llong uint_to_llong + #define ushort_ullong_bin_op uint_ullong_bin_op + #define ushort_ullong_scalar_bin_op uint_ullong_scalar_bin_op + #define copy_ushort_to_ullong copy_uint_to_ullong + #define ushort_to_ullong uint_to_ullong + #define ushort_float_bin_op uint_float_bin_op + #define ushort_float_scalar_bin_op uint_float_scalar_bin_op + #define copy_ushort_to_float copy_uint_to_float + #define ushort_to_float uint_to_float + #define ushort_double_bin_op uint_double_bin_op + #define ushort_double_scalar_bin_op uint_double_scalar_bin_op + #define copy_ushort_to_double copy_uint_to_double + #define ushort_to_double uint_to_double + #define ushort_ldouble_bin_op uint_ldouble_bin_op + #define ushort_ldouble_scalar_bin_op uint_ldouble_scalar_bin_op + #define copy_ushort_to_ldouble copy_uint_to_ldouble + #define ushort_to_ldouble uint_to_ldouble + #define ushort_unary_op uint_unary_op + #define ushort_cmp_function uint_cmp_function + #define ushort_to_binary uint_to_binary + #define ushort_to_one_double uint_to_one_double +#endif /* SHORT_IS_NOT_INT */ + +/* int */ +/* (int, signed char) */ +#define GENERIC_BINARY_FUNCTION int_char_bin_op +#define GENERIC_A_TYPE int +#define GENERIC_B_TYPE signed char +#define GENERIC_C_TYPE int +#define GENERIC_BIT_OPERATIONS 1 +#define TRAP_DIV_ZERO 1 +#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) +#define POW_RESULT_TYPE double +#define MOD_FUNCTION(a,b) ((a) % (b)) +#define GENERIC_COPY_FUNCTION copy_int_to_char +#define int_to_char NULL +#include "slarith.inc" + +/* (int, unsigned char) */ +#define GENERIC_BINARY_FUNCTION int_uchar_bin_op +#define GENERIC_A_TYPE int +#define GENERIC_B_TYPE unsigned char +#define GENERIC_B_TYPE_UNSIGNED 1 +#define GENERIC_C_TYPE int +#define GENERIC_BIT_OPERATIONS 1 +#define TRAP_DIV_ZERO 1 +#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) +#define POW_RESULT_TYPE double +#define MOD_FUNCTION(a,b) ((a) % (b)) +#define GENERIC_COPY_FUNCTION copy_int_to_uchar +#define int_to_uchar NULL +#include "slarith.inc" + +/* (int, short) */ +#if SHORT_IS_NOT_INT + #define GENERIC_BINARY_FUNCTION int_short_bin_op + #define GENERIC_A_TYPE int + #define GENERIC_B_TYPE short + #define GENERIC_C_TYPE int + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_int_to_short + #define int_to_short NULL + #include "slarith.inc" +#else + #define int_short_bin_op int_int_bin_op + #define copy_int_to_short copy_int_to_int + #define int_to_short int_to_int +#endif /* SHORT_IS_NOT_INT */ + +/* (int, unsigned short) */ +#if SHORT_IS_NOT_INT + #define GENERIC_BINARY_FUNCTION int_ushort_bin_op + #define GENERIC_A_TYPE int + #define GENERIC_B_TYPE unsigned short + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE int + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_int_to_ushort + #define int_to_ushort NULL + #include "slarith.inc" +#else + #define int_ushort_bin_op int_uint_bin_op + #define copy_int_to_ushort copy_int_to_uint + #define int_to_ushort int_to_uint +#endif /* SHORT_IS_NOT_INT */ + +/* (int, int) */ +#define GENERIC_BINARY_FUNCTION int_int_bin_op +#define GENERIC_A_TYPE int +#define GENERIC_B_TYPE int +#define GENERIC_C_TYPE int +#define GENERIC_BIT_OPERATIONS 1 +#define TRAP_DIV_ZERO 1 +#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) +#define POW_RESULT_TYPE double +#define MOD_FUNCTION(a,b) ((a) % (b)) +#define SCALAR_BINARY_FUNCTION int_int_scalar_bin_op +#define PUSH_SCALAR_OBJ_FUN(a) SLclass_push_int_obj(SLANG_INT_TYPE, (int)(a)) +#define PUSH_POW_OBJ_FUN(a) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (a)) +#define GENERIC_UNARY_FUNCTION int_unary_op +#define ABS_FUNCTION(a) abs(a) +#define CMP_FUNCTION int_cmp_function +#define TO_DOUBLE_FUNCTION int_to_one_double +#define GENERIC_COPY_FUNCTION copy_int_to_int +#define int_to_int convert_self_to_self +#include "slarith.inc" + +/* (int, unsigned int) */ +#define GENERIC_BINARY_FUNCTION int_uint_bin_op +#define GENERIC_A_TYPE int +#define GENERIC_B_TYPE unsigned int +#define GENERIC_B_TYPE_UNSIGNED 1 +#define GENERIC_C_TYPE unsigned int +#define GENERIC_BIT_OPERATIONS 1 +#define TRAP_DIV_ZERO 1 +#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) +#define POW_RESULT_TYPE double +#define MOD_FUNCTION(a,b) ((a) % (b)) +#define copy_int_to_uint copy_int_to_int +#define int_to_uint convert_self_to_self +#include "slarith.inc" + +/* (int, long) */ +#if LONG_IS_NOT_INT + #define GENERIC_BINARY_FUNCTION int_long_bin_op + #define GENERIC_A_TYPE int + #define GENERIC_B_TYPE long + #define GENERIC_C_TYPE long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_int_to_long + #define GENERIC_CONVERT_FUNCTION int_to_long + #include "slarith.inc" +#else + #define int_long_bin_op int_int_bin_op + #define copy_int_to_long copy_int_to_int + #define int_to_long int_to_int +#endif /* LONG_IS_NOT_INT */ + +/* (int, unsigned long) */ +#if LONG_IS_NOT_INT + #define GENERIC_BINARY_FUNCTION int_ulong_bin_op + #define GENERIC_A_TYPE int + #define GENERIC_B_TYPE unsigned long + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_int_to_ulong + #define GENERIC_CONVERT_FUNCTION int_to_ulong + #include "slarith.inc" +#else + #define int_ulong_bin_op int_uint_bin_op + #define copy_int_to_ulong copy_int_to_uint + #define int_to_ulong int_to_uint +#endif /* LONG_IS_NOT_INT */ + +/* (int, long long) */ #if defined(HAVE_LONG_LONG) -#define copy_ullong_to_llong copy_llong_to_llong -#define ullong_to_llong NULL + #if LLONG_IS_NOT_LONG + #define GENERIC_BINARY_FUNCTION int_llong_bin_op + #define GENERIC_A_TYPE int + #define GENERIC_B_TYPE long long + #define GENERIC_C_TYPE long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_int_to_llong + #define GENERIC_CONVERT_FUNCTION int_to_llong + #include "slarith.inc" + #else + #define int_llong_bin_op int_long_bin_op + #define copy_int_to_llong copy_int_to_long + #define int_to_llong int_to_long + #endif /* LLONG_IS_NOT_LONG */ #endif /* defined(HAVE_LONG_LONG) */ + +/* (int, unsigned long long) */ #if defined(HAVE_LONG_LONG) -#define copy_ullong_to_ullong copy_llong_to_llong -#define ullong_to_ullong NULL + #if LLONG_IS_NOT_LONG + #define GENERIC_BINARY_FUNCTION int_ullong_bin_op + #define GENERIC_A_TYPE int + #define GENERIC_B_TYPE unsigned long long + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_int_to_ullong + #define GENERIC_CONVERT_FUNCTION int_to_ullong + #include "slarith.inc" + #else + #define int_ullong_bin_op int_ulong_bin_op + #define copy_int_to_ullong copy_int_to_ulong + #define int_to_ullong int_to_ulong + #endif /* LLONG_IS_NOT_LONG */ #endif /* defined(HAVE_LONG_LONG) */ + +/* (int, float) */ #if SLANG_HAS_FLOAT -DEFUN_1(copy_ullong_to_float,unsigned long long,float) -DEFUN_2(ullong_to_float,unsigned long long,float,copy_ullong_to_float) + #define GENERIC_BINARY_FUNCTION int_float_bin_op + #define GENERIC_A_TYPE int + #define GENERIC_B_TYPE float + #define GENERIC_C_TYPE float + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE float + #define MOD_FUNCTION(a,b) (float)fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_int_to_float + #define GENERIC_CONVERT_FUNCTION int_to_float + #include "slarith.inc" #endif /* SLANG_HAS_FLOAT */ + +/* (int, double) */ #if SLANG_HAS_FLOAT -DEFUN_1(copy_ullong_to_double,unsigned long long,double) -DEFUN_2(ullong_to_double,unsigned long long,double,copy_ullong_to_double) + #define GENERIC_BINARY_FUNCTION int_double_bin_op + #define GENERIC_A_TYPE int + #define GENERIC_B_TYPE double + #define GENERIC_C_TYPE double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_int_to_double + #define GENERIC_CONVERT_FUNCTION int_to_double + #include "slarith.inc" #endif /* SLANG_HAS_FLOAT */ + +/* (int, long double) */ #if defined(HAVE_LONG_DOUBLE) -DEFUN_1(copy_ullong_to_ldouble,unsigned long long,long double) -DEFUN_2(ullong_to_ldouble,unsigned long long,long double,copy_ullong_to_ldouble) + #define GENERIC_BINARY_FUNCTION int_ldouble_bin_op + #define GENERIC_A_TYPE int + #define GENERIC_B_TYPE long double + #define GENERIC_C_TYPE long double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) lpow((long double)(a),(long double)(b)) + #define POW_RESULT_TYPE long double + #define MOD_FUNCTION(a,b) fmodl((a),(b)) + #define GENERIC_COPY_FUNCTION copy_int_to_ldouble + #define GENERIC_CONVERT_FUNCTION int_to_ldouble + #include "slarith.inc" #endif /* defined(HAVE_LONG_DOUBLE) */ -#if SLANG_HAS_FLOAT -TO_DOUBLE_FUN(ullong_to_one_double,unsigned long long) -#endif -#endif /* defined(HAVE_LONG_LONG) */ -/* ------------ float ---------- */ -#if SLANG_HAS_FLOAT -DEFUN_1(copy_float_to_char,float,signed char) -#define float_to_char NULL -DEFUN_1(copy_float_to_uchar,float,unsigned char) -#define float_to_uchar NULL -DEFUN_1(copy_float_to_short,float,short) -#define float_to_short NULL -DEFUN_1(copy_float_to_ushort,float,unsigned short) -#define float_to_ushort NULL -DEFUN_1(copy_float_to_int,float,int) -#define float_to_int NULL -DEFUN_1(copy_float_to_uint,float,unsigned int) -#define float_to_uint NULL -#if LONG_IS_INT -# define copy_float_to_long copy_float_to_int -#else -DEFUN_1(copy_float_to_long,float,long) -#endif -#define float_to_long NULL -#if LONG_IS_INT -# define copy_float_to_ulong copy_float_to_uint -#else -DEFUN_1(copy_float_to_ulong,float,unsigned long) -#endif -#define float_to_ulong NULL + +/* unsigned int */ +/* (unsigned int, signed char) */ +#define uint_char_bin_op NULL +#define GENERIC_A_TYPE unsigned int +#define GENERIC_A_TYPE_UNSIGNED 1 +#define GENERIC_B_TYPE signed char +#define GENERIC_C_TYPE unsigned int +#define GENERIC_BIT_OPERATIONS 1 +#define TRAP_DIV_ZERO 1 +#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) +#define POW_RESULT_TYPE double +#define MOD_FUNCTION(a,b) ((a) % (b)) +#define GENERIC_COPY_FUNCTION copy_uint_to_char +#define uint_to_char NULL +#include "slarith.inc" + +/* (unsigned int, unsigned char) */ +#define uint_uchar_bin_op NULL +#define GENERIC_A_TYPE unsigned int +#define GENERIC_A_TYPE_UNSIGNED 1 +#define GENERIC_B_TYPE unsigned char +#define GENERIC_B_TYPE_UNSIGNED 1 +#define GENERIC_C_TYPE unsigned int +#define GENERIC_BIT_OPERATIONS 1 +#define TRAP_DIV_ZERO 1 +#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) +#define POW_RESULT_TYPE double +#define MOD_FUNCTION(a,b) ((a) % (b)) +#define GENERIC_COPY_FUNCTION copy_uint_to_uchar +#define uint_to_uchar NULL +#include "slarith.inc" + +/* (unsigned int, short) */ +#if SHORT_IS_NOT_INT + #define uint_short_bin_op NULL + #define GENERIC_A_TYPE unsigned int + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE short + #define GENERIC_C_TYPE unsigned int + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_uint_to_short + #define uint_to_short NULL + #include "slarith.inc" +#else + #define uint_short_bin_op uint_int_bin_op + #define copy_uint_to_short copy_uint_to_int + #define uint_to_short uint_to_int +#endif /* SHORT_IS_NOT_INT */ + +/* (unsigned int, unsigned short) */ +#if SHORT_IS_NOT_INT + #define uint_ushort_bin_op NULL + #define GENERIC_A_TYPE unsigned int + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE unsigned short + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned int + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_uint_to_ushort + #define uint_to_ushort NULL + #include "slarith.inc" +#else + #define uint_ushort_bin_op uint_uint_bin_op + #define copy_uint_to_ushort copy_uint_to_uint + #define uint_to_ushort uint_to_uint +#endif /* SHORT_IS_NOT_INT */ + +/* (unsigned int, int) */ +#define GENERIC_BINARY_FUNCTION uint_int_bin_op +#define GENERIC_A_TYPE unsigned int +#define GENERIC_A_TYPE_UNSIGNED 1 +#define GENERIC_B_TYPE int +#define GENERIC_C_TYPE unsigned int +#define GENERIC_BIT_OPERATIONS 1 +#define TRAP_DIV_ZERO 1 +#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) +#define POW_RESULT_TYPE double +#define MOD_FUNCTION(a,b) ((a) % (b)) +#define copy_uint_to_int copy_int_to_int +#define uint_to_int convert_self_to_self +#include "slarith.inc" + +/* (unsigned int, unsigned int) */ +#define GENERIC_BINARY_FUNCTION uint_uint_bin_op +#define GENERIC_A_TYPE unsigned int +#define GENERIC_A_TYPE_UNSIGNED 1 +#define GENERIC_B_TYPE unsigned int +#define GENERIC_B_TYPE_UNSIGNED 1 +#define GENERIC_C_TYPE unsigned int +#define GENERIC_BIT_OPERATIONS 1 +#define TRAP_DIV_ZERO 1 +#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) +#define POW_RESULT_TYPE double +#define MOD_FUNCTION(a,b) ((a) % (b)) +#define SCALAR_BINARY_FUNCTION uint_uint_scalar_bin_op +#define PUSH_SCALAR_OBJ_FUN(a) SLclass_push_int_obj(SLANG_UINT_TYPE, (int)(a)) +#define PUSH_POW_OBJ_FUN(a) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (a)) +#define GENERIC_UNARY_FUNCTION uint_unary_op +#define ABS_FUNCTION(a) (a) +#define CMP_FUNCTION uint_cmp_function +#define TO_BINARY_FUNCTION uint_to_binary +#define TO_DOUBLE_FUNCTION uint_to_one_double +#define copy_uint_to_uint copy_int_to_int +#define uint_to_uint convert_self_to_self +#include "slarith.inc" + +/* (unsigned int, long) */ +#if LONG_IS_NOT_INT + #define uint_long_bin_op NULL + #define GENERIC_A_TYPE unsigned int + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE long + #define GENERIC_C_TYPE long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_uint_to_long + #define GENERIC_CONVERT_FUNCTION uint_to_long + #include "slarith.inc" +#else + #define uint_long_bin_op uint_int_bin_op + #define copy_uint_to_long copy_uint_to_int + #define uint_to_long uint_to_int +#endif /* LONG_IS_NOT_INT */ + +/* (unsigned int, unsigned long) */ +#if LONG_IS_NOT_INT + #define uint_ulong_bin_op NULL + #define GENERIC_A_TYPE unsigned int + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE unsigned long + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_uint_to_ulong + #define GENERIC_CONVERT_FUNCTION uint_to_ulong + #include "slarith.inc" +#else + #define uint_ulong_bin_op uint_uint_bin_op + #define copy_uint_to_ulong copy_uint_to_uint + #define uint_to_ulong uint_to_uint +#endif /* LONG_IS_NOT_INT */ + +/* (unsigned int, long long) */ #if defined(HAVE_LONG_LONG) -DEFUN_1(copy_float_to_llong,float,long long) -#define float_to_llong NULL + #if LLONG_IS_NOT_LONG + #define uint_llong_bin_op NULL + #define GENERIC_A_TYPE unsigned int + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE long long + #define GENERIC_C_TYPE long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_uint_to_llong + #define GENERIC_CONVERT_FUNCTION uint_to_llong + #include "slarith.inc" + #else + #define uint_llong_bin_op uint_long_bin_op + #define copy_uint_to_llong copy_uint_to_long + #define uint_to_llong uint_to_long + #endif /* LLONG_IS_NOT_LONG */ #endif /* defined(HAVE_LONG_LONG) */ + +/* (unsigned int, unsigned long long) */ #if defined(HAVE_LONG_LONG) -DEFUN_1(copy_float_to_ullong,float,unsigned long long) -#define float_to_ullong NULL + #if LLONG_IS_NOT_LONG + #define uint_ullong_bin_op NULL + #define GENERIC_A_TYPE unsigned int + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE unsigned long long + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_uint_to_ullong + #define GENERIC_CONVERT_FUNCTION uint_to_ullong + #include "slarith.inc" + #else + #define uint_ullong_bin_op uint_ulong_bin_op + #define copy_uint_to_ullong copy_uint_to_ulong + #define uint_to_ullong uint_to_ulong + #endif /* LLONG_IS_NOT_LONG */ #endif /* defined(HAVE_LONG_LONG) */ + +/* (unsigned int, float) */ #if SLANG_HAS_FLOAT -DEFUN_1(copy_float_to_float,float,float) -#define float_to_float NULL + #define uint_float_bin_op NULL + #define GENERIC_A_TYPE unsigned int + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE float + #define GENERIC_C_TYPE float + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE float + #define MOD_FUNCTION(a,b) (float)fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_uint_to_float + #define GENERIC_CONVERT_FUNCTION uint_to_float + #include "slarith.inc" #endif /* SLANG_HAS_FLOAT */ + +/* (unsigned int, double) */ #if SLANG_HAS_FLOAT -DEFUN_1(copy_float_to_double,float,double) -DEFUN_2(float_to_double,float,double,copy_float_to_double) + #define GENERIC_BINARY_FUNCTION uint_double_bin_op + #define GENERIC_A_TYPE unsigned int + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE double + #define GENERIC_C_TYPE double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_uint_to_double + #define GENERIC_CONVERT_FUNCTION uint_to_double + #include "slarith.inc" #endif /* SLANG_HAS_FLOAT */ + +/* (unsigned int, long double) */ #if defined(HAVE_LONG_DOUBLE) -DEFUN_1(copy_float_to_ldouble,float,long double) -DEFUN_2(float_to_ldouble,float,long double,copy_float_to_ldouble) + #define uint_ldouble_bin_op NULL + #define GENERIC_A_TYPE unsigned int + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE long double + #define GENERIC_C_TYPE long double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) lpow((long double)(a),(long double)(b)) + #define POW_RESULT_TYPE long double + #define MOD_FUNCTION(a,b) fmodl((a),(b)) + #define GENERIC_COPY_FUNCTION copy_uint_to_ldouble + #define GENERIC_CONVERT_FUNCTION uint_to_ldouble + #include "slarith.inc" #endif /* defined(HAVE_LONG_DOUBLE) */ -#if SLANG_HAS_FLOAT -TO_DOUBLE_FUN(float_to_one_double,float) -#endif -#endif /* SLANG_HAS_FLOAT */ -/* ------------ double ---------- */ -#if SLANG_HAS_FLOAT -DEFUN_1(copy_double_to_char,double,signed char) -#define double_to_char NULL -DEFUN_1(copy_double_to_uchar,double,unsigned char) -#define double_to_uchar NULL -DEFUN_1(copy_double_to_short,double,short) -#define double_to_short NULL -DEFUN_1(copy_double_to_ushort,double,unsigned short) -#define double_to_ushort NULL -DEFUN_1(copy_double_to_int,double,int) -#define double_to_int NULL -DEFUN_1(copy_double_to_uint,double,unsigned int) -#define double_to_uint NULL -#if LONG_IS_INT -# define copy_double_to_long copy_double_to_int + +/* long */ +#if LONG_IS_NOT_INT +/* (long, signed char) */ + #define long_char_bin_op NULL + #define GENERIC_A_TYPE long + #define GENERIC_B_TYPE signed char + #define GENERIC_C_TYPE long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_long_to_char + #define long_to_char NULL + #include "slarith.inc" + +/* (long, unsigned char) */ + #define long_uchar_bin_op NULL + #define GENERIC_A_TYPE long + #define GENERIC_B_TYPE unsigned char + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_long_to_uchar + #define long_to_uchar NULL + #include "slarith.inc" + +/* (long, short) */ + #if SHORT_IS_NOT_INT + #define long_short_bin_op NULL + #define GENERIC_A_TYPE long + #define GENERIC_B_TYPE short + #define GENERIC_C_TYPE long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_long_to_short + #define long_to_short NULL + #include "slarith.inc" + #else + #define long_short_bin_op long_int_bin_op + #define copy_long_to_short copy_long_to_int + #define long_to_short long_to_int + #endif /* SHORT_IS_NOT_INT */ + +/* (long, unsigned short) */ + #if SHORT_IS_NOT_INT + #define long_ushort_bin_op NULL + #define GENERIC_A_TYPE long + #define GENERIC_B_TYPE unsigned short + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_long_to_ushort + #define long_to_ushort NULL + #include "slarith.inc" + #else + #define long_ushort_bin_op long_uint_bin_op + #define copy_long_to_ushort copy_long_to_uint + #define long_to_ushort long_to_uint + #endif /* SHORT_IS_NOT_INT */ + +/* (long, int) */ + #define GENERIC_BINARY_FUNCTION long_int_bin_op + #define GENERIC_A_TYPE long + #define GENERIC_B_TYPE int + #define GENERIC_C_TYPE long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_long_to_int + #define long_to_int NULL + #include "slarith.inc" + +/* (long, unsigned int) */ + #define long_uint_bin_op NULL + #define GENERIC_A_TYPE long + #define GENERIC_B_TYPE unsigned int + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_long_to_uint + #define long_to_uint NULL + #include "slarith.inc" + +/* (long, long) */ + #define GENERIC_BINARY_FUNCTION long_long_bin_op + #define GENERIC_A_TYPE long + #define GENERIC_B_TYPE long + #define GENERIC_C_TYPE long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define SCALAR_BINARY_FUNCTION long_long_scalar_bin_op + #define PUSH_SCALAR_OBJ_FUN(a) SLclass_push_long_obj(SLANG_LONG_TYPE, (long)(a)) + #define PUSH_POW_OBJ_FUN(a) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (a)) + #define GENERIC_UNARY_FUNCTION long_unary_op + #define ABS_FUNCTION(a) labs(a) + #define CMP_FUNCTION long_cmp_function + #define TO_DOUBLE_FUNCTION long_to_one_double + #define GENERIC_COPY_FUNCTION copy_long_to_long + #define long_to_long convert_self_to_self + #include "slarith.inc" + +/* (long, unsigned long) */ + #if LONG_IS_NOT_INT + #define long_ulong_bin_op NULL + #define GENERIC_A_TYPE long + #define GENERIC_B_TYPE unsigned long + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define copy_long_to_ulong copy_long_to_long + #define long_to_ulong convert_self_to_self + #include "slarith.inc" + #else + #define long_ulong_bin_op long_uint_bin_op + #define copy_long_to_ulong copy_long_to_uint + #define long_to_ulong long_to_uint + #endif /* LONG_IS_NOT_INT */ + +/* (long, long long) */ + #if defined(HAVE_LONG_LONG) + #if LLONG_IS_NOT_LONG + #define long_llong_bin_op NULL + #define GENERIC_A_TYPE long + #define GENERIC_B_TYPE long long + #define GENERIC_C_TYPE long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_long_to_llong + #define GENERIC_CONVERT_FUNCTION long_to_llong + #include "slarith.inc" + #else + #define long_llong_bin_op long_long_bin_op + #define copy_long_to_llong copy_long_to_long + #define long_to_llong long_to_long + #endif /* LLONG_IS_NOT_LONG */ + #endif /* defined(HAVE_LONG_LONG) */ + +/* (long, unsigned long long) */ + #if defined(HAVE_LONG_LONG) + #if LLONG_IS_NOT_LONG + #define long_ullong_bin_op NULL + #define GENERIC_A_TYPE long + #define GENERIC_B_TYPE unsigned long long + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_long_to_ullong + #define GENERIC_CONVERT_FUNCTION long_to_ullong + #include "slarith.inc" + #else + #define long_ullong_bin_op long_ulong_bin_op + #define copy_long_to_ullong copy_long_to_ulong + #define long_to_ullong long_to_ulong + #endif /* LLONG_IS_NOT_LONG */ + #endif /* defined(HAVE_LONG_LONG) */ + +/* (long, float) */ + #if SLANG_HAS_FLOAT + #define long_float_bin_op NULL + #define GENERIC_A_TYPE long + #define GENERIC_B_TYPE float + #define GENERIC_C_TYPE float + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE float + #define MOD_FUNCTION(a,b) (float)fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_long_to_float + #define GENERIC_CONVERT_FUNCTION long_to_float + #include "slarith.inc" + #endif /* SLANG_HAS_FLOAT */ + +/* (long, double) */ + #if SLANG_HAS_FLOAT + #define GENERIC_BINARY_FUNCTION long_double_bin_op + #define GENERIC_A_TYPE long + #define GENERIC_B_TYPE double + #define GENERIC_C_TYPE double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_long_to_double + #define GENERIC_CONVERT_FUNCTION long_to_double + #include "slarith.inc" + #endif /* SLANG_HAS_FLOAT */ + +/* (long, long double) */ + #if defined(HAVE_LONG_DOUBLE) + #define long_ldouble_bin_op NULL + #define GENERIC_A_TYPE long + #define GENERIC_B_TYPE long double + #define GENERIC_C_TYPE long double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) lpow((long double)(a),(long double)(b)) + #define POW_RESULT_TYPE long double + #define MOD_FUNCTION(a,b) fmodl((a),(b)) + #define GENERIC_COPY_FUNCTION copy_long_to_ldouble + #define GENERIC_CONVERT_FUNCTION long_to_ldouble + #include "slarith.inc" + #endif /* defined(HAVE_LONG_DOUBLE) */ + #else -DEFUN_1(copy_double_to_long,double,long) -#endif -#define double_to_long NULL -#if LONG_IS_INT -# define copy_double_to_ulong copy_double_to_uint + #define long_char_bin_op int_char_bin_op + #define long_char_scalar_bin_op int_char_scalar_bin_op + #define copy_long_to_char copy_int_to_char + #define long_to_char int_to_char + #define long_uchar_bin_op int_uchar_bin_op + #define long_uchar_scalar_bin_op int_uchar_scalar_bin_op + #define copy_long_to_uchar copy_int_to_uchar + #define long_to_uchar int_to_uchar + #define long_short_bin_op int_short_bin_op + #define long_short_scalar_bin_op int_short_scalar_bin_op + #define copy_long_to_short copy_int_to_short + #define long_to_short int_to_short + #define long_ushort_bin_op int_ushort_bin_op + #define long_ushort_scalar_bin_op int_ushort_scalar_bin_op + #define copy_long_to_ushort copy_int_to_ushort + #define long_to_ushort int_to_ushort + #define long_int_bin_op int_int_bin_op + #define long_int_scalar_bin_op int_int_scalar_bin_op + #define copy_long_to_int copy_int_to_int + #define long_to_int int_to_int + #define long_uint_bin_op int_uint_bin_op + #define long_uint_scalar_bin_op int_uint_scalar_bin_op + #define copy_long_to_uint copy_int_to_uint + #define long_to_uint int_to_uint + #define long_long_bin_op int_int_bin_op + #define long_long_scalar_bin_op int_int_scalar_bin_op + #define copy_long_to_long copy_int_to_int + #define long_to_long int_to_int + #define long_ulong_bin_op int_ulong_bin_op + #define long_ulong_scalar_bin_op int_ulong_scalar_bin_op + #define copy_long_to_ulong copy_int_to_ulong + #define long_to_ulong int_to_ulong + #define long_llong_bin_op int_llong_bin_op + #define long_llong_scalar_bin_op int_llong_scalar_bin_op + #define copy_long_to_llong copy_int_to_llong + #define long_to_llong int_to_llong + #define long_ullong_bin_op int_ullong_bin_op + #define long_ullong_scalar_bin_op int_ullong_scalar_bin_op + #define copy_long_to_ullong copy_int_to_ullong + #define long_to_ullong int_to_ullong + #define long_float_bin_op int_float_bin_op + #define long_float_scalar_bin_op int_float_scalar_bin_op + #define copy_long_to_float copy_int_to_float + #define long_to_float int_to_float + #define long_double_bin_op int_double_bin_op + #define long_double_scalar_bin_op int_double_scalar_bin_op + #define copy_long_to_double copy_int_to_double + #define long_to_double int_to_double + #define long_ldouble_bin_op int_ldouble_bin_op + #define long_ldouble_scalar_bin_op int_ldouble_scalar_bin_op + #define copy_long_to_ldouble copy_int_to_ldouble + #define long_to_ldouble int_to_ldouble + #define long_unary_op int_unary_op + #define long_cmp_function int_cmp_function + #define long_to_one_double int_to_one_double +#endif /* LONG_IS_NOT_INT */ + +/* unsigned long */ +#if LONG_IS_NOT_INT +/* (unsigned long, signed char) */ + #define ulong_char_bin_op NULL + #define GENERIC_A_TYPE unsigned long + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE signed char + #define GENERIC_C_TYPE unsigned long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_ulong_to_char + #define ulong_to_char NULL + #include "slarith.inc" + +/* (unsigned long, unsigned char) */ + #define ulong_uchar_bin_op NULL + #define GENERIC_A_TYPE unsigned long + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE unsigned char + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_ulong_to_uchar + #define ulong_to_uchar NULL + #include "slarith.inc" + +/* (unsigned long, short) */ + #if SHORT_IS_NOT_INT + #define ulong_short_bin_op NULL + #define GENERIC_A_TYPE unsigned long + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE short + #define GENERIC_C_TYPE unsigned long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_ulong_to_short + #define ulong_to_short NULL + #include "slarith.inc" + #else + #define ulong_short_bin_op ulong_int_bin_op + #define copy_ulong_to_short copy_ulong_to_int + #define ulong_to_short ulong_to_int + #endif /* SHORT_IS_NOT_INT */ + +/* (unsigned long, unsigned short) */ + #if SHORT_IS_NOT_INT + #define ulong_ushort_bin_op NULL + #define GENERIC_A_TYPE unsigned long + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE unsigned short + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_ulong_to_ushort + #define ulong_to_ushort NULL + #include "slarith.inc" + #else + #define ulong_ushort_bin_op ulong_uint_bin_op + #define copy_ulong_to_ushort copy_ulong_to_uint + #define ulong_to_ushort ulong_to_uint + #endif /* SHORT_IS_NOT_INT */ + +/* (unsigned long, int) */ + #define GENERIC_BINARY_FUNCTION ulong_int_bin_op + #define GENERIC_A_TYPE unsigned long + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE int + #define GENERIC_C_TYPE unsigned long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_ulong_to_int + #define ulong_to_int NULL + #include "slarith.inc" + +/* (unsigned long, unsigned int) */ + #define ulong_uint_bin_op NULL + #define GENERIC_A_TYPE unsigned long + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE unsigned int + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_ulong_to_uint + #define ulong_to_uint NULL + #include "slarith.inc" + +/* (unsigned long, long) */ + #if LONG_IS_NOT_INT + #define ulong_long_bin_op NULL + #define GENERIC_A_TYPE unsigned long + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE long + #define GENERIC_C_TYPE unsigned long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define copy_ulong_to_long copy_long_to_long + #define ulong_to_long convert_self_to_self + #include "slarith.inc" + #else + #define ulong_long_bin_op ulong_int_bin_op + #define copy_ulong_to_long copy_ulong_to_int + #define ulong_to_long ulong_to_int + #endif /* LONG_IS_NOT_INT */ + +/* (unsigned long, unsigned long) */ + #define GENERIC_BINARY_FUNCTION ulong_ulong_bin_op + #define GENERIC_A_TYPE unsigned long + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE unsigned long + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define SCALAR_BINARY_FUNCTION ulong_ulong_scalar_bin_op + #define PUSH_SCALAR_OBJ_FUN(a) SLclass_push_long_obj(SLANG_ULONG_TYPE, (long)(a)) + #define PUSH_POW_OBJ_FUN(a) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (a)) + #define GENERIC_UNARY_FUNCTION ulong_unary_op + #define ABS_FUNCTION(a) (a) + #define CMP_FUNCTION ulong_cmp_function + #define TO_BINARY_FUNCTION ulong_to_binary + #define TO_DOUBLE_FUNCTION ulong_to_one_double + #define copy_ulong_to_ulong copy_long_to_long + #define ulong_to_ulong convert_self_to_self + #include "slarith.inc" + +/* (unsigned long, long long) */ + #if defined(HAVE_LONG_LONG) + #if LLONG_IS_NOT_LONG + #define ulong_llong_bin_op NULL + #define GENERIC_A_TYPE unsigned long + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE long long + #define GENERIC_C_TYPE long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_ulong_to_llong + #define GENERIC_CONVERT_FUNCTION ulong_to_llong + #include "slarith.inc" + #else + #define ulong_llong_bin_op ulong_long_bin_op + #define copy_ulong_to_llong copy_ulong_to_long + #define ulong_to_llong ulong_to_long + #endif /* LLONG_IS_NOT_LONG */ + #endif /* defined(HAVE_LONG_LONG) */ + +/* (unsigned long, unsigned long long) */ + #if defined(HAVE_LONG_LONG) + #if LLONG_IS_NOT_LONG + #define ulong_ullong_bin_op NULL + #define GENERIC_A_TYPE unsigned long + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE unsigned long long + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_ulong_to_ullong + #define GENERIC_CONVERT_FUNCTION ulong_to_ullong + #include "slarith.inc" + #else + #define ulong_ullong_bin_op ulong_ulong_bin_op + #define copy_ulong_to_ullong copy_ulong_to_ulong + #define ulong_to_ullong ulong_to_ulong + #endif /* LLONG_IS_NOT_LONG */ + #endif /* defined(HAVE_LONG_LONG) */ + +/* (unsigned long, float) */ + #if SLANG_HAS_FLOAT + #define ulong_float_bin_op NULL + #define GENERIC_A_TYPE unsigned long + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE float + #define GENERIC_C_TYPE float + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE float + #define MOD_FUNCTION(a,b) (float)fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_ulong_to_float + #define GENERIC_CONVERT_FUNCTION ulong_to_float + #include "slarith.inc" + #endif /* SLANG_HAS_FLOAT */ + +/* (unsigned long, double) */ + #if SLANG_HAS_FLOAT + #define GENERIC_BINARY_FUNCTION ulong_double_bin_op + #define GENERIC_A_TYPE unsigned long + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE double + #define GENERIC_C_TYPE double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_ulong_to_double + #define GENERIC_CONVERT_FUNCTION ulong_to_double + #include "slarith.inc" + #endif /* SLANG_HAS_FLOAT */ + +/* (unsigned long, long double) */ + #if defined(HAVE_LONG_DOUBLE) + #define ulong_ldouble_bin_op NULL + #define GENERIC_A_TYPE unsigned long + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE long double + #define GENERIC_C_TYPE long double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) lpow((long double)(a),(long double)(b)) + #define POW_RESULT_TYPE long double + #define MOD_FUNCTION(a,b) fmodl((a),(b)) + #define GENERIC_COPY_FUNCTION copy_ulong_to_ldouble + #define GENERIC_CONVERT_FUNCTION ulong_to_ldouble + #include "slarith.inc" + #endif /* defined(HAVE_LONG_DOUBLE) */ + #else -DEFUN_1(copy_double_to_ulong,double,unsigned long) -#endif -#define double_to_ulong NULL + #define ulong_char_bin_op uint_char_bin_op + #define ulong_char_scalar_bin_op uint_char_scalar_bin_op + #define copy_ulong_to_char copy_uint_to_char + #define ulong_to_char uint_to_char + #define ulong_uchar_bin_op uint_uchar_bin_op + #define ulong_uchar_scalar_bin_op uint_uchar_scalar_bin_op + #define copy_ulong_to_uchar copy_uint_to_uchar + #define ulong_to_uchar uint_to_uchar + #define ulong_short_bin_op uint_short_bin_op + #define ulong_short_scalar_bin_op uint_short_scalar_bin_op + #define copy_ulong_to_short copy_uint_to_short + #define ulong_to_short uint_to_short + #define ulong_ushort_bin_op uint_ushort_bin_op + #define ulong_ushort_scalar_bin_op uint_ushort_scalar_bin_op + #define copy_ulong_to_ushort copy_uint_to_ushort + #define ulong_to_ushort uint_to_ushort + #define ulong_int_bin_op uint_int_bin_op + #define ulong_int_scalar_bin_op uint_int_scalar_bin_op + #define copy_ulong_to_int copy_uint_to_int + #define ulong_to_int uint_to_int + #define ulong_uint_bin_op uint_uint_bin_op + #define ulong_uint_scalar_bin_op uint_uint_scalar_bin_op + #define copy_ulong_to_uint copy_uint_to_uint + #define ulong_to_uint uint_to_uint + #define ulong_long_bin_op uint_long_bin_op + #define ulong_long_scalar_bin_op uint_long_scalar_bin_op + #define copy_ulong_to_long copy_uint_to_long + #define ulong_to_long uint_to_long + #define ulong_ulong_bin_op uint_uint_bin_op + #define ulong_ulong_scalar_bin_op uint_uint_scalar_bin_op + #define copy_ulong_to_ulong copy_uint_to_uint + #define ulong_to_ulong uint_to_uint + #define ulong_llong_bin_op uint_llong_bin_op + #define ulong_llong_scalar_bin_op uint_llong_scalar_bin_op + #define copy_ulong_to_llong copy_uint_to_llong + #define ulong_to_llong uint_to_llong + #define ulong_ullong_bin_op uint_ullong_bin_op + #define ulong_ullong_scalar_bin_op uint_ullong_scalar_bin_op + #define copy_ulong_to_ullong copy_uint_to_ullong + #define ulong_to_ullong uint_to_ullong + #define ulong_float_bin_op uint_float_bin_op + #define ulong_float_scalar_bin_op uint_float_scalar_bin_op + #define copy_ulong_to_float copy_uint_to_float + #define ulong_to_float uint_to_float + #define ulong_double_bin_op uint_double_bin_op + #define ulong_double_scalar_bin_op uint_double_scalar_bin_op + #define copy_ulong_to_double copy_uint_to_double + #define ulong_to_double uint_to_double + #define ulong_ldouble_bin_op uint_ldouble_bin_op + #define ulong_ldouble_scalar_bin_op uint_ldouble_scalar_bin_op + #define copy_ulong_to_ldouble copy_uint_to_ldouble + #define ulong_to_ldouble uint_to_ldouble + #define ulong_unary_op uint_unary_op + #define ulong_cmp_function uint_cmp_function + #define ulong_to_binary uint_to_binary + #define ulong_to_one_double uint_to_one_double +#endif /* LONG_IS_NOT_INT */ + +/* long long */ #if defined(HAVE_LONG_LONG) -DEFUN_1(copy_double_to_llong,double,long long) -#define double_to_llong NULL + #if LLONG_IS_NOT_LONG +/* (long long, signed char) */ + #define llong_char_bin_op NULL + #define GENERIC_A_TYPE long long + #define GENERIC_B_TYPE signed char + #define GENERIC_C_TYPE long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_llong_to_char + #define llong_to_char NULL + #include "slarith.inc" + +/* (long long, unsigned char) */ + #define llong_uchar_bin_op NULL + #define GENERIC_A_TYPE long long + #define GENERIC_B_TYPE unsigned char + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_llong_to_uchar + #define llong_to_uchar NULL + #include "slarith.inc" + +/* (long long, short) */ + #if SHORT_IS_NOT_INT + #define llong_short_bin_op NULL + #define GENERIC_A_TYPE long long + #define GENERIC_B_TYPE short + #define GENERIC_C_TYPE long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_llong_to_short + #define llong_to_short NULL + #include "slarith.inc" + #else + #define llong_short_bin_op llong_int_bin_op + #define copy_llong_to_short copy_llong_to_int + #define llong_to_short llong_to_int + #endif /* SHORT_IS_NOT_INT */ + +/* (long long, unsigned short) */ + #if SHORT_IS_NOT_INT + #define llong_ushort_bin_op NULL + #define GENERIC_A_TYPE long long + #define GENERIC_B_TYPE unsigned short + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_llong_to_ushort + #define llong_to_ushort NULL + #include "slarith.inc" + #else + #define llong_ushort_bin_op llong_uint_bin_op + #define copy_llong_to_ushort copy_llong_to_uint + #define llong_to_ushort llong_to_uint + #endif /* SHORT_IS_NOT_INT */ + +/* (long long, int) */ + #define GENERIC_BINARY_FUNCTION llong_int_bin_op + #define GENERIC_A_TYPE long long + #define GENERIC_B_TYPE int + #define GENERIC_C_TYPE long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_llong_to_int + #define llong_to_int NULL + #include "slarith.inc" + +/* (long long, unsigned int) */ + #define llong_uint_bin_op NULL + #define GENERIC_A_TYPE long long + #define GENERIC_B_TYPE unsigned int + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_llong_to_uint + #define llong_to_uint NULL + #include "slarith.inc" + +/* (long long, long) */ + #if LONG_IS_NOT_INT + #define llong_long_bin_op NULL + #define GENERIC_A_TYPE long long + #define GENERIC_B_TYPE long + #define GENERIC_C_TYPE long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_llong_to_long + #define llong_to_long NULL + #include "slarith.inc" + #else + #define llong_long_bin_op llong_int_bin_op + #define copy_llong_to_long copy_llong_to_int + #define llong_to_long llong_to_int + #endif /* LONG_IS_NOT_INT */ + +/* (long long, unsigned long) */ + #if LONG_IS_NOT_INT + #define llong_ulong_bin_op NULL + #define GENERIC_A_TYPE long long + #define GENERIC_B_TYPE unsigned long + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_llong_to_ulong + #define llong_to_ulong NULL + #include "slarith.inc" + #else + #define llong_ulong_bin_op llong_uint_bin_op + #define copy_llong_to_ulong copy_llong_to_uint + #define llong_to_ulong llong_to_uint + #endif /* LONG_IS_NOT_INT */ + +/* (long long, long long) */ + #define GENERIC_BINARY_FUNCTION llong_llong_bin_op + #define GENERIC_A_TYPE long long + #define GENERIC_B_TYPE long long + #define GENERIC_C_TYPE long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define SCALAR_BINARY_FUNCTION llong_llong_scalar_bin_op + #define PUSH_SCALAR_OBJ_FUN(a) SLclass_push_llong_obj(SLANG_LLONG_TYPE, (long long)(a)) + #define PUSH_POW_OBJ_FUN(a) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (a)) + #define GENERIC_UNARY_FUNCTION llong_unary_op + #define ABS_FUNCTION(a) (((a) >= 0) ? (a) : -(a)) + #define CMP_FUNCTION llong_cmp_function + #define TO_DOUBLE_FUNCTION llong_to_one_double + #define GENERIC_COPY_FUNCTION copy_llong_to_llong + #define llong_to_llong convert_self_to_self + #include "slarith.inc" + +/* (long long, unsigned long long) */ + #if defined(HAVE_LONG_LONG) + #if LLONG_IS_NOT_LONG + #define llong_ullong_bin_op NULL + #define GENERIC_A_TYPE long long + #define GENERIC_B_TYPE unsigned long long + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define copy_llong_to_ullong copy_llong_to_llong + #define llong_to_ullong convert_self_to_self + #include "slarith.inc" + #else + #define llong_ullong_bin_op llong_ulong_bin_op + #define copy_llong_to_ullong copy_llong_to_ulong + #define llong_to_ullong llong_to_ulong + #endif /* LLONG_IS_NOT_LONG */ + #endif /* defined(HAVE_LONG_LONG) */ + +/* (long long, float) */ + #if SLANG_HAS_FLOAT + #define llong_float_bin_op NULL + #define GENERIC_A_TYPE long long + #define GENERIC_B_TYPE float + #define GENERIC_C_TYPE float + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE float + #define MOD_FUNCTION(a,b) (float)fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_llong_to_float + #define GENERIC_CONVERT_FUNCTION llong_to_float + #include "slarith.inc" + #endif /* SLANG_HAS_FLOAT */ + +/* (long long, double) */ + #if SLANG_HAS_FLOAT + #define GENERIC_BINARY_FUNCTION llong_double_bin_op + #define GENERIC_A_TYPE long long + #define GENERIC_B_TYPE double + #define GENERIC_C_TYPE double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_llong_to_double + #define GENERIC_CONVERT_FUNCTION llong_to_double + #include "slarith.inc" + #endif /* SLANG_HAS_FLOAT */ + +/* (long long, long double) */ + #if defined(HAVE_LONG_DOUBLE) + #define llong_ldouble_bin_op NULL + #define GENERIC_A_TYPE long long + #define GENERIC_B_TYPE long double + #define GENERIC_C_TYPE long double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) lpow((long double)(a),(long double)(b)) + #define POW_RESULT_TYPE long double + #define MOD_FUNCTION(a,b) fmodl((a),(b)) + #define GENERIC_COPY_FUNCTION copy_llong_to_ldouble + #define GENERIC_CONVERT_FUNCTION llong_to_ldouble + #include "slarith.inc" + #endif /* defined(HAVE_LONG_DOUBLE) */ + + #else + #define llong_char_bin_op long_char_bin_op + #define llong_char_scalar_bin_op long_char_scalar_bin_op + #define copy_llong_to_char copy_long_to_char + #define llong_to_char long_to_char + #define llong_uchar_bin_op long_uchar_bin_op + #define llong_uchar_scalar_bin_op long_uchar_scalar_bin_op + #define copy_llong_to_uchar copy_long_to_uchar + #define llong_to_uchar long_to_uchar + #define llong_short_bin_op long_short_bin_op + #define llong_short_scalar_bin_op long_short_scalar_bin_op + #define copy_llong_to_short copy_long_to_short + #define llong_to_short long_to_short + #define llong_ushort_bin_op long_ushort_bin_op + #define llong_ushort_scalar_bin_op long_ushort_scalar_bin_op + #define copy_llong_to_ushort copy_long_to_ushort + #define llong_to_ushort long_to_ushort + #define llong_int_bin_op long_int_bin_op + #define llong_int_scalar_bin_op long_int_scalar_bin_op + #define copy_llong_to_int copy_long_to_int + #define llong_to_int long_to_int + #define llong_uint_bin_op long_uint_bin_op + #define llong_uint_scalar_bin_op long_uint_scalar_bin_op + #define copy_llong_to_uint copy_long_to_uint + #define llong_to_uint long_to_uint + #define llong_long_bin_op long_long_bin_op + #define llong_long_scalar_bin_op long_long_scalar_bin_op + #define copy_llong_to_long copy_long_to_long + #define llong_to_long long_to_long + #define llong_ulong_bin_op long_ulong_bin_op + #define llong_ulong_scalar_bin_op long_ulong_scalar_bin_op + #define copy_llong_to_ulong copy_long_to_ulong + #define llong_to_ulong long_to_ulong + #define llong_llong_bin_op long_long_bin_op + #define llong_llong_scalar_bin_op long_long_scalar_bin_op + #define copy_llong_to_llong copy_long_to_long + #define llong_to_llong long_to_long + #define llong_ullong_bin_op long_ullong_bin_op + #define llong_ullong_scalar_bin_op long_ullong_scalar_bin_op + #define copy_llong_to_ullong copy_long_to_ullong + #define llong_to_ullong long_to_ullong + #define llong_float_bin_op long_float_bin_op + #define llong_float_scalar_bin_op long_float_scalar_bin_op + #define copy_llong_to_float copy_long_to_float + #define llong_to_float long_to_float + #define llong_double_bin_op long_double_bin_op + #define llong_double_scalar_bin_op long_double_scalar_bin_op + #define copy_llong_to_double copy_long_to_double + #define llong_to_double long_to_double + #define llong_ldouble_bin_op long_ldouble_bin_op + #define llong_ldouble_scalar_bin_op long_ldouble_scalar_bin_op + #define copy_llong_to_ldouble copy_long_to_ldouble + #define llong_to_ldouble long_to_ldouble + #define llong_unary_op long_unary_op + #define llong_cmp_function long_cmp_function + #define llong_to_one_double long_to_one_double + #endif /* LLONG_IS_NOT_LONG */ #endif /* defined(HAVE_LONG_LONG) */ + +/* unsigned long long */ #if defined(HAVE_LONG_LONG) -DEFUN_1(copy_double_to_ullong,double,unsigned long long) -#define double_to_ullong NULL -#endif /* defined(HAVE_LONG_LONG) */ -#if SLANG_HAS_FLOAT -DEFUN_1(copy_double_to_float,double,float) -#define double_to_float NULL -#endif /* SLANG_HAS_FLOAT */ -#if SLANG_HAS_FLOAT -DEFUN_1(copy_double_to_double,double,double) -#define double_to_double NULL -#endif /* SLANG_HAS_FLOAT */ -#if defined(HAVE_LONG_DOUBLE) -DEFUN_1(copy_double_to_ldouble,double,long double) -DEFUN_2(double_to_ldouble,double,long double,copy_double_to_ldouble) -#endif /* defined(HAVE_LONG_DOUBLE) */ -#if SLANG_HAS_FLOAT -TO_DOUBLE_FUN(double_to_one_double,double) -#endif -#endif /* SLANG_HAS_FLOAT */ + #if LLONG_IS_NOT_LONG +/* (unsigned long long, signed char) */ + #define ullong_char_bin_op NULL + #define GENERIC_A_TYPE unsigned long long + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE signed char + #define GENERIC_C_TYPE unsigned long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_ullong_to_char + #define ullong_to_char NULL + #include "slarith.inc" -/* ------------ long double ---------- */ -#if defined(HAVE_LONG_DOUBLE) -DEFUN_1(copy_ldouble_to_char,long double,signed char) -#define ldouble_to_char NULL -DEFUN_1(copy_ldouble_to_uchar,long double,unsigned char) -#define ldouble_to_uchar NULL -DEFUN_1(copy_ldouble_to_short,long double,short) -#define ldouble_to_short NULL -DEFUN_1(copy_ldouble_to_ushort,long double,unsigned short) -#define ldouble_to_ushort NULL -DEFUN_1(copy_ldouble_to_int,long double,int) -#define ldouble_to_int NULL -DEFUN_1(copy_ldouble_to_uint,long double,unsigned int) -#define ldouble_to_uint NULL -#if LONG_IS_INT -# define copy_ldouble_to_long copy_ldouble_to_int -#else -DEFUN_1(copy_ldouble_to_long,long double,long) -#endif -#define ldouble_to_long NULL -#if LONG_IS_INT -# define copy_ldouble_to_ulong copy_ldouble_to_uint -#else -DEFUN_1(copy_ldouble_to_ulong,long double,unsigned long) -#endif -#define ldouble_to_ulong NULL -#if defined(HAVE_LONG_LONG) -DEFUN_1(copy_ldouble_to_llong,long double,long long) -#define ldouble_to_llong NULL -#endif /* defined(HAVE_LONG_LONG) */ -#if defined(HAVE_LONG_LONG) -DEFUN_1(copy_ldouble_to_ullong,long double,unsigned long long) -#define ldouble_to_ullong NULL +/* (unsigned long long, unsigned char) */ + #define ullong_uchar_bin_op NULL + #define GENERIC_A_TYPE unsigned long long + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE unsigned char + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_ullong_to_uchar + #define ullong_to_uchar NULL + #include "slarith.inc" + +/* (unsigned long long, short) */ + #if SHORT_IS_NOT_INT + #define ullong_short_bin_op NULL + #define GENERIC_A_TYPE unsigned long long + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE short + #define GENERIC_C_TYPE unsigned long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_ullong_to_short + #define ullong_to_short NULL + #include "slarith.inc" + #else + #define ullong_short_bin_op ullong_int_bin_op + #define copy_ullong_to_short copy_ullong_to_int + #define ullong_to_short ullong_to_int + #endif /* SHORT_IS_NOT_INT */ + +/* (unsigned long long, unsigned short) */ + #if SHORT_IS_NOT_INT + #define ullong_ushort_bin_op NULL + #define GENERIC_A_TYPE unsigned long long + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE unsigned short + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_ullong_to_ushort + #define ullong_to_ushort NULL + #include "slarith.inc" + #else + #define ullong_ushort_bin_op ullong_uint_bin_op + #define copy_ullong_to_ushort copy_ullong_to_uint + #define ullong_to_ushort ullong_to_uint + #endif /* SHORT_IS_NOT_INT */ + +/* (unsigned long long, int) */ + #define GENERIC_BINARY_FUNCTION ullong_int_bin_op + #define GENERIC_A_TYPE unsigned long long + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE int + #define GENERIC_C_TYPE unsigned long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_ullong_to_int + #define ullong_to_int NULL + #include "slarith.inc" + +/* (unsigned long long, unsigned int) */ + #define ullong_uint_bin_op NULL + #define GENERIC_A_TYPE unsigned long long + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE unsigned int + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_ullong_to_uint + #define ullong_to_uint NULL + #include "slarith.inc" + +/* (unsigned long long, long) */ + #if LONG_IS_NOT_INT + #define ullong_long_bin_op NULL + #define GENERIC_A_TYPE unsigned long long + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE long + #define GENERIC_C_TYPE unsigned long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_ullong_to_long + #define ullong_to_long NULL + #include "slarith.inc" + #else + #define ullong_long_bin_op ullong_int_bin_op + #define copy_ullong_to_long copy_ullong_to_int + #define ullong_to_long ullong_to_int + #endif /* LONG_IS_NOT_INT */ + +/* (unsigned long long, unsigned long) */ + #if LONG_IS_NOT_INT + #define ullong_ulong_bin_op NULL + #define GENERIC_A_TYPE unsigned long long + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE unsigned long + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define GENERIC_COPY_FUNCTION copy_ullong_to_ulong + #define ullong_to_ulong NULL + #include "slarith.inc" + #else + #define ullong_ulong_bin_op ullong_uint_bin_op + #define copy_ullong_to_ulong copy_ullong_to_uint + #define ullong_to_ulong ullong_to_uint + #endif /* LONG_IS_NOT_INT */ + +/* (unsigned long long, long long) */ + #if defined(HAVE_LONG_LONG) + #if LLONG_IS_NOT_LONG + #define ullong_llong_bin_op NULL + #define GENERIC_A_TYPE unsigned long long + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE long long + #define GENERIC_C_TYPE unsigned long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define copy_ullong_to_llong copy_llong_to_llong + #define ullong_to_llong convert_self_to_self + #include "slarith.inc" + #else + #define ullong_llong_bin_op ullong_long_bin_op + #define copy_ullong_to_llong copy_ullong_to_long + #define ullong_to_llong ullong_to_long + #endif /* LLONG_IS_NOT_LONG */ + #endif /* defined(HAVE_LONG_LONG) */ + +/* (unsigned long long, unsigned long long) */ + #define GENERIC_BINARY_FUNCTION ullong_ullong_bin_op + #define GENERIC_A_TYPE unsigned long long + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE unsigned long long + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE unsigned long long + #define GENERIC_BIT_OPERATIONS 1 + #define TRAP_DIV_ZERO 1 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) ((a) % (b)) + #define SCALAR_BINARY_FUNCTION ullong_ullong_scalar_bin_op + #define PUSH_SCALAR_OBJ_FUN(a) SLclass_push_llong_obj(SLANG_ULLONG_TYPE, (long long)(a)) + #define PUSH_POW_OBJ_FUN(a) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (a)) + #define GENERIC_UNARY_FUNCTION ullong_unary_op + #define ABS_FUNCTION(a) (a) + #define CMP_FUNCTION ullong_cmp_function + #define TO_BINARY_FUNCTION ullong_to_binary + #define TO_DOUBLE_FUNCTION ullong_to_one_double + #define copy_ullong_to_ullong copy_llong_to_llong + #define ullong_to_ullong convert_self_to_self + #include "slarith.inc" + +/* (unsigned long long, float) */ + #if SLANG_HAS_FLOAT + #define ullong_float_bin_op NULL + #define GENERIC_A_TYPE unsigned long long + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE float + #define GENERIC_C_TYPE float + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE float + #define MOD_FUNCTION(a,b) (float)fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_ullong_to_float + #define GENERIC_CONVERT_FUNCTION ullong_to_float + #include "slarith.inc" + #endif /* SLANG_HAS_FLOAT */ + +/* (unsigned long long, double) */ + #if SLANG_HAS_FLOAT + #define GENERIC_BINARY_FUNCTION ullong_double_bin_op + #define GENERIC_A_TYPE unsigned long long + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE double + #define GENERIC_C_TYPE double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_ullong_to_double + #define GENERIC_CONVERT_FUNCTION ullong_to_double + #include "slarith.inc" + #endif /* SLANG_HAS_FLOAT */ + +/* (unsigned long long, long double) */ + #if defined(HAVE_LONG_DOUBLE) + #define ullong_ldouble_bin_op NULL + #define GENERIC_A_TYPE unsigned long long + #define GENERIC_A_TYPE_UNSIGNED 1 + #define GENERIC_B_TYPE long double + #define GENERIC_C_TYPE long double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) lpow((long double)(a),(long double)(b)) + #define POW_RESULT_TYPE long double + #define MOD_FUNCTION(a,b) fmodl((a),(b)) + #define GENERIC_COPY_FUNCTION copy_ullong_to_ldouble + #define GENERIC_CONVERT_FUNCTION ullong_to_ldouble + #include "slarith.inc" + #endif /* defined(HAVE_LONG_DOUBLE) */ + + #else + #define ullong_char_bin_op ulong_char_bin_op + #define ullong_char_scalar_bin_op ulong_char_scalar_bin_op + #define copy_ullong_to_char copy_ulong_to_char + #define ullong_to_char ulong_to_char + #define ullong_uchar_bin_op ulong_uchar_bin_op + #define ullong_uchar_scalar_bin_op ulong_uchar_scalar_bin_op + #define copy_ullong_to_uchar copy_ulong_to_uchar + #define ullong_to_uchar ulong_to_uchar + #define ullong_short_bin_op ulong_short_bin_op + #define ullong_short_scalar_bin_op ulong_short_scalar_bin_op + #define copy_ullong_to_short copy_ulong_to_short + #define ullong_to_short ulong_to_short + #define ullong_ushort_bin_op ulong_ushort_bin_op + #define ullong_ushort_scalar_bin_op ulong_ushort_scalar_bin_op + #define copy_ullong_to_ushort copy_ulong_to_ushort + #define ullong_to_ushort ulong_to_ushort + #define ullong_int_bin_op ulong_int_bin_op + #define ullong_int_scalar_bin_op ulong_int_scalar_bin_op + #define copy_ullong_to_int copy_ulong_to_int + #define ullong_to_int ulong_to_int + #define ullong_uint_bin_op ulong_uint_bin_op + #define ullong_uint_scalar_bin_op ulong_uint_scalar_bin_op + #define copy_ullong_to_uint copy_ulong_to_uint + #define ullong_to_uint ulong_to_uint + #define ullong_long_bin_op ulong_long_bin_op + #define ullong_long_scalar_bin_op ulong_long_scalar_bin_op + #define copy_ullong_to_long copy_ulong_to_long + #define ullong_to_long ulong_to_long + #define ullong_ulong_bin_op ulong_ulong_bin_op + #define ullong_ulong_scalar_bin_op ulong_ulong_scalar_bin_op + #define copy_ullong_to_ulong copy_ulong_to_ulong + #define ullong_to_ulong ulong_to_ulong + #define ullong_llong_bin_op ulong_llong_bin_op + #define ullong_llong_scalar_bin_op ulong_llong_scalar_bin_op + #define copy_ullong_to_llong copy_ulong_to_llong + #define ullong_to_llong ulong_to_llong + #define ullong_ullong_bin_op ulong_ulong_bin_op + #define ullong_ullong_scalar_bin_op ulong_ulong_scalar_bin_op + #define copy_ullong_to_ullong copy_ulong_to_ulong + #define ullong_to_ullong ulong_to_ulong + #define ullong_float_bin_op ulong_float_bin_op + #define ullong_float_scalar_bin_op ulong_float_scalar_bin_op + #define copy_ullong_to_float copy_ulong_to_float + #define ullong_to_float ulong_to_float + #define ullong_double_bin_op ulong_double_bin_op + #define ullong_double_scalar_bin_op ulong_double_scalar_bin_op + #define copy_ullong_to_double copy_ulong_to_double + #define ullong_to_double ulong_to_double + #define ullong_ldouble_bin_op ulong_ldouble_bin_op + #define ullong_ldouble_scalar_bin_op ulong_ldouble_scalar_bin_op + #define copy_ullong_to_ldouble copy_ulong_to_ldouble + #define ullong_to_ldouble ulong_to_ldouble + #define ullong_unary_op ulong_unary_op + #define ullong_cmp_function ulong_cmp_function + #define ullong_to_binary ulong_to_binary + #define ullong_to_one_double ulong_to_one_double + #endif /* LLONG_IS_NOT_LONG */ #endif /* defined(HAVE_LONG_LONG) */ + +/* float */ #if SLANG_HAS_FLOAT -DEFUN_1(copy_ldouble_to_float,long double,float) -#define ldouble_to_float NULL +/* (float, signed char) */ + #define float_char_bin_op NULL + #define GENERIC_A_TYPE float + #define GENERIC_B_TYPE signed char + #define GENERIC_C_TYPE float + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE float + #define MOD_FUNCTION(a,b) (float)fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_float_to_char + #define float_to_char NULL + #include "slarith.inc" + +/* (float, unsigned char) */ + #define float_uchar_bin_op NULL + #define GENERIC_A_TYPE float + #define GENERIC_B_TYPE unsigned char + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE float + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE float + #define MOD_FUNCTION(a,b) (float)fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_float_to_uchar + #define float_to_uchar NULL + #include "slarith.inc" + +/* (float, short) */ + #if SHORT_IS_NOT_INT + #define float_short_bin_op NULL + #define GENERIC_A_TYPE float + #define GENERIC_B_TYPE short + #define GENERIC_C_TYPE float + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE float + #define MOD_FUNCTION(a,b) (float)fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_float_to_short + #define float_to_short NULL + #include "slarith.inc" + #else + #define float_short_bin_op float_int_bin_op + #define copy_float_to_short copy_float_to_int + #define float_to_short float_to_int + #endif /* SHORT_IS_NOT_INT */ + +/* (float, unsigned short) */ + #if SHORT_IS_NOT_INT + #define float_ushort_bin_op NULL + #define GENERIC_A_TYPE float + #define GENERIC_B_TYPE unsigned short + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE float + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE float + #define MOD_FUNCTION(a,b) (float)fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_float_to_ushort + #define float_to_ushort NULL + #include "slarith.inc" + #else + #define float_ushort_bin_op float_uint_bin_op + #define copy_float_to_ushort copy_float_to_uint + #define float_to_ushort float_to_uint + #endif /* SHORT_IS_NOT_INT */ + +/* (float, int) */ + #define GENERIC_BINARY_FUNCTION float_int_bin_op + #define GENERIC_A_TYPE float + #define GENERIC_B_TYPE int + #define GENERIC_C_TYPE float + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE float + #define MOD_FUNCTION(a,b) (float)fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_float_to_int + #define float_to_int NULL + #include "slarith.inc" + +/* (float, unsigned int) */ + #define float_uint_bin_op NULL + #define GENERIC_A_TYPE float + #define GENERIC_B_TYPE unsigned int + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE float + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE float + #define MOD_FUNCTION(a,b) (float)fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_float_to_uint + #define float_to_uint NULL + #include "slarith.inc" + +/* (float, long) */ + #if LONG_IS_NOT_INT + #define float_long_bin_op NULL + #define GENERIC_A_TYPE float + #define GENERIC_B_TYPE long + #define GENERIC_C_TYPE float + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE float + #define MOD_FUNCTION(a,b) (float)fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_float_to_long + #define float_to_long NULL + #include "slarith.inc" + #else + #define float_long_bin_op float_int_bin_op + #define copy_float_to_long copy_float_to_int + #define float_to_long float_to_int + #endif /* LONG_IS_NOT_INT */ + +/* (float, unsigned long) */ + #if LONG_IS_NOT_INT + #define float_ulong_bin_op NULL + #define GENERIC_A_TYPE float + #define GENERIC_B_TYPE unsigned long + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE float + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE float + #define MOD_FUNCTION(a,b) (float)fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_float_to_ulong + #define float_to_ulong NULL + #include "slarith.inc" + #else + #define float_ulong_bin_op float_uint_bin_op + #define copy_float_to_ulong copy_float_to_uint + #define float_to_ulong float_to_uint + #endif /* LONG_IS_NOT_INT */ + +/* (float, long long) */ + #if defined(HAVE_LONG_LONG) + #if LLONG_IS_NOT_LONG + #define float_llong_bin_op NULL + #define GENERIC_A_TYPE float + #define GENERIC_B_TYPE long long + #define GENERIC_C_TYPE float + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE float + #define MOD_FUNCTION(a,b) (float)fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_float_to_llong + #define float_to_llong NULL + #include "slarith.inc" + #else + #define float_llong_bin_op float_long_bin_op + #define copy_float_to_llong copy_float_to_long + #define float_to_llong float_to_long + #endif /* LLONG_IS_NOT_LONG */ + #endif /* defined(HAVE_LONG_LONG) */ + +/* (float, unsigned long long) */ + #if defined(HAVE_LONG_LONG) + #if LLONG_IS_NOT_LONG + #define float_ullong_bin_op NULL + #define GENERIC_A_TYPE float + #define GENERIC_B_TYPE unsigned long long + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE float + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE float + #define MOD_FUNCTION(a,b) (float)fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_float_to_ullong + #define float_to_ullong NULL + #include "slarith.inc" + #else + #define float_ullong_bin_op float_ulong_bin_op + #define copy_float_to_ullong copy_float_to_ulong + #define float_to_ullong float_to_ulong + #endif /* LLONG_IS_NOT_LONG */ + #endif /* defined(HAVE_LONG_LONG) */ + +/* (float, float) */ + #define GENERIC_BINARY_FUNCTION float_float_bin_op + #define GENERIC_A_TYPE float + #define GENERIC_B_TYPE float + #define GENERIC_C_TYPE float + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE float + #define MOD_FUNCTION(a,b) (float)fmod((a),(b)) + #define SCALAR_BINARY_FUNCTION float_float_scalar_bin_op + #define PUSH_SCALAR_OBJ_FUN(a) SLclass_push_float_obj(SLANG_FLOAT_TYPE, (float)(a)) + #define PUSH_POW_OBJ_FUN(a) SLclass_push_float_obj(SLANG_FLOAT_TYPE,(a)) + #define GENERIC_UNARY_FUNCTION float_unary_op + #define ABS_FUNCTION(a) (float)fabs((double)(a)) + #define CMP_FUNCTION float_cmp_function + #define TO_DOUBLE_FUNCTION float_to_one_double + #define GENERIC_COPY_FUNCTION copy_float_to_float + #define float_to_float convert_self_to_self + #include "slarith.inc" + +/* (float, double) */ + #if SLANG_HAS_FLOAT + #define GENERIC_BINARY_FUNCTION float_double_bin_op + #define GENERIC_A_TYPE float + #define GENERIC_B_TYPE double + #define GENERIC_C_TYPE double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_float_to_double + #define GENERIC_CONVERT_FUNCTION float_to_double + #include "slarith.inc" + #endif /* SLANG_HAS_FLOAT */ + +/* (float, long double) */ + #if defined(HAVE_LONG_DOUBLE) + #define float_ldouble_bin_op NULL + #define GENERIC_A_TYPE float + #define GENERIC_B_TYPE long double + #define GENERIC_C_TYPE long double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) lpow((long double)(a),(long double)(b)) + #define POW_RESULT_TYPE long double + #define MOD_FUNCTION(a,b) fmodl((a),(b)) + #define GENERIC_COPY_FUNCTION copy_float_to_ldouble + #define GENERIC_CONVERT_FUNCTION float_to_ldouble + #include "slarith.inc" + #endif /* defined(HAVE_LONG_DOUBLE) */ + #endif /* SLANG_HAS_FLOAT */ + +/* double */ #if SLANG_HAS_FLOAT -DEFUN_1(copy_ldouble_to_double,long double,double) -#define ldouble_to_double NULL +/* (double, signed char) */ + #define GENERIC_BINARY_FUNCTION double_char_bin_op + #define GENERIC_A_TYPE double + #define GENERIC_B_TYPE signed char + #define GENERIC_C_TYPE double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_double_to_char + #define double_to_char NULL + #include "slarith.inc" + +/* (double, unsigned char) */ + #define GENERIC_BINARY_FUNCTION double_uchar_bin_op + #define GENERIC_A_TYPE double + #define GENERIC_B_TYPE unsigned char + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_double_to_uchar + #define double_to_uchar NULL + #include "slarith.inc" + +/* (double, short) */ + #if SHORT_IS_NOT_INT + #define GENERIC_BINARY_FUNCTION double_short_bin_op + #define GENERIC_A_TYPE double + #define GENERIC_B_TYPE short + #define GENERIC_C_TYPE double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_double_to_short + #define double_to_short NULL + #include "slarith.inc" + #else + #define double_short_bin_op double_int_bin_op + #define copy_double_to_short copy_double_to_int + #define double_to_short double_to_int + #endif /* SHORT_IS_NOT_INT */ + +/* (double, unsigned short) */ + #if SHORT_IS_NOT_INT + #define GENERIC_BINARY_FUNCTION double_ushort_bin_op + #define GENERIC_A_TYPE double + #define GENERIC_B_TYPE unsigned short + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_double_to_ushort + #define double_to_ushort NULL + #include "slarith.inc" + #else + #define double_ushort_bin_op double_uint_bin_op + #define copy_double_to_ushort copy_double_to_uint + #define double_to_ushort double_to_uint + #endif /* SHORT_IS_NOT_INT */ + +/* (double, int) */ + #define GENERIC_BINARY_FUNCTION double_int_bin_op + #define GENERIC_A_TYPE double + #define GENERIC_B_TYPE int + #define GENERIC_C_TYPE double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_double_to_int + #define double_to_int NULL + #include "slarith.inc" + +/* (double, unsigned int) */ + #define GENERIC_BINARY_FUNCTION double_uint_bin_op + #define GENERIC_A_TYPE double + #define GENERIC_B_TYPE unsigned int + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_double_to_uint + #define double_to_uint NULL + #include "slarith.inc" + +/* (double, long) */ + #if LONG_IS_NOT_INT + #define GENERIC_BINARY_FUNCTION double_long_bin_op + #define GENERIC_A_TYPE double + #define GENERIC_B_TYPE long + #define GENERIC_C_TYPE double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_double_to_long + #define double_to_long NULL + #include "slarith.inc" + #else + #define double_long_bin_op double_int_bin_op + #define copy_double_to_long copy_double_to_int + #define double_to_long double_to_int + #endif /* LONG_IS_NOT_INT */ + +/* (double, unsigned long) */ + #if LONG_IS_NOT_INT + #define GENERIC_BINARY_FUNCTION double_ulong_bin_op + #define GENERIC_A_TYPE double + #define GENERIC_B_TYPE unsigned long + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_double_to_ulong + #define double_to_ulong NULL + #include "slarith.inc" + #else + #define double_ulong_bin_op double_uint_bin_op + #define copy_double_to_ulong copy_double_to_uint + #define double_to_ulong double_to_uint + #endif /* LONG_IS_NOT_INT */ + +/* (double, long long) */ + #if defined(HAVE_LONG_LONG) + #if LLONG_IS_NOT_LONG + #define GENERIC_BINARY_FUNCTION double_llong_bin_op + #define GENERIC_A_TYPE double + #define GENERIC_B_TYPE long long + #define GENERIC_C_TYPE double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_double_to_llong + #define double_to_llong NULL + #include "slarith.inc" + #else + #define double_llong_bin_op double_long_bin_op + #define copy_double_to_llong copy_double_to_long + #define double_to_llong double_to_long + #endif /* LLONG_IS_NOT_LONG */ + #endif /* defined(HAVE_LONG_LONG) */ + +/* (double, unsigned long long) */ + #if defined(HAVE_LONG_LONG) + #if LLONG_IS_NOT_LONG + #define GENERIC_BINARY_FUNCTION double_ullong_bin_op + #define GENERIC_A_TYPE double + #define GENERIC_B_TYPE unsigned long long + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_double_to_ullong + #define double_to_ullong NULL + #include "slarith.inc" + #else + #define double_ullong_bin_op double_ulong_bin_op + #define copy_double_to_ullong copy_double_to_ulong + #define double_to_ullong double_to_ulong + #endif /* LLONG_IS_NOT_LONG */ + #endif /* defined(HAVE_LONG_LONG) */ + +/* (double, float) */ + #if SLANG_HAS_FLOAT + #define GENERIC_BINARY_FUNCTION double_float_bin_op + #define GENERIC_A_TYPE double + #define GENERIC_B_TYPE float + #define GENERIC_C_TYPE double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) fmod((a),(b)) + #define GENERIC_COPY_FUNCTION copy_double_to_float + #define double_to_float NULL + #include "slarith.inc" + #endif /* SLANG_HAS_FLOAT */ + +/* (double, double) */ + #define GENERIC_BINARY_FUNCTION double_double_bin_op + #define GENERIC_A_TYPE double + #define GENERIC_B_TYPE double + #define GENERIC_C_TYPE double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) + #define POW_RESULT_TYPE double + #define MOD_FUNCTION(a,b) fmod((a),(b)) + #define SCALAR_BINARY_FUNCTION double_double_scalar_bin_op + #define PUSH_SCALAR_OBJ_FUN(a) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (double)(a)) + #define PUSH_POW_OBJ_FUN(a) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (a)) + #define GENERIC_UNARY_FUNCTION double_unary_op + #define ABS_FUNCTION(a) fabs(a) + #define CMP_FUNCTION double_cmp_function + #define TO_DOUBLE_FUNCTION double_to_one_double + #define GENERIC_COPY_FUNCTION copy_double_to_double + #define double_to_double convert_self_to_self + #include "slarith.inc" + +/* (double, long double) */ + #if defined(HAVE_LONG_DOUBLE) + #define GENERIC_BINARY_FUNCTION double_ldouble_bin_op + #define GENERIC_A_TYPE double + #define GENERIC_B_TYPE long double + #define GENERIC_C_TYPE long double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) lpow((long double)(a),(long double)(b)) + #define POW_RESULT_TYPE long double + #define MOD_FUNCTION(a,b) fmodl((a),(b)) + #define GENERIC_COPY_FUNCTION copy_double_to_ldouble + #define GENERIC_CONVERT_FUNCTION double_to_ldouble + #include "slarith.inc" + #endif /* defined(HAVE_LONG_DOUBLE) */ + #endif /* SLANG_HAS_FLOAT */ + +/* long double */ #if defined(HAVE_LONG_DOUBLE) -DEFUN_1(copy_ldouble_to_ldouble,long double,long double) -#define ldouble_to_ldouble NULL -#endif /* defined(HAVE_LONG_DOUBLE) */ -#if SLANG_HAS_FLOAT -TO_DOUBLE_FUN(ldouble_to_one_double,long double) -#endif +/* (long double, signed char) */ + #define ldouble_char_bin_op NULL + #define GENERIC_A_TYPE long double + #define GENERIC_B_TYPE signed char + #define GENERIC_C_TYPE long double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) lpow((long double)(a),(long double)(b)) + #define POW_RESULT_TYPE long double + #define MOD_FUNCTION(a,b) fmodl((a),(b)) + #define GENERIC_COPY_FUNCTION copy_ldouble_to_char + #define ldouble_to_char NULL + #include "slarith.inc" + +/* (long double, unsigned char) */ + #define ldouble_uchar_bin_op NULL + #define GENERIC_A_TYPE long double + #define GENERIC_B_TYPE unsigned char + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE long double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) lpow((long double)(a),(long double)(b)) + #define POW_RESULT_TYPE long double + #define MOD_FUNCTION(a,b) fmodl((a),(b)) + #define GENERIC_COPY_FUNCTION copy_ldouble_to_uchar + #define ldouble_to_uchar NULL + #include "slarith.inc" + +/* (long double, short) */ + #if SHORT_IS_NOT_INT + #define ldouble_short_bin_op NULL + #define GENERIC_A_TYPE long double + #define GENERIC_B_TYPE short + #define GENERIC_C_TYPE long double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) lpow((long double)(a),(long double)(b)) + #define POW_RESULT_TYPE long double + #define MOD_FUNCTION(a,b) fmodl((a),(b)) + #define GENERIC_COPY_FUNCTION copy_ldouble_to_short + #define ldouble_to_short NULL + #include "slarith.inc" + #else + #define ldouble_short_bin_op ldouble_int_bin_op + #define copy_ldouble_to_short copy_ldouble_to_int + #define ldouble_to_short ldouble_to_int + #endif /* SHORT_IS_NOT_INT */ + +/* (long double, unsigned short) */ + #if SHORT_IS_NOT_INT + #define ldouble_ushort_bin_op NULL + #define GENERIC_A_TYPE long double + #define GENERIC_B_TYPE unsigned short + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE long double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) lpow((long double)(a),(long double)(b)) + #define POW_RESULT_TYPE long double + #define MOD_FUNCTION(a,b) fmodl((a),(b)) + #define GENERIC_COPY_FUNCTION copy_ldouble_to_ushort + #define ldouble_to_ushort NULL + #include "slarith.inc" + #else + #define ldouble_ushort_bin_op ldouble_uint_bin_op + #define copy_ldouble_to_ushort copy_ldouble_to_uint + #define ldouble_to_ushort ldouble_to_uint + #endif /* SHORT_IS_NOT_INT */ + +/* (long double, int) */ + #define GENERIC_BINARY_FUNCTION ldouble_int_bin_op + #define GENERIC_A_TYPE long double + #define GENERIC_B_TYPE int + #define GENERIC_C_TYPE long double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) lpow((long double)(a),(long double)(b)) + #define POW_RESULT_TYPE long double + #define MOD_FUNCTION(a,b) fmodl((a),(b)) + #define GENERIC_COPY_FUNCTION copy_ldouble_to_int + #define ldouble_to_int NULL + #include "slarith.inc" + +/* (long double, unsigned int) */ + #define ldouble_uint_bin_op NULL + #define GENERIC_A_TYPE long double + #define GENERIC_B_TYPE unsigned int + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE long double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) lpow((long double)(a),(long double)(b)) + #define POW_RESULT_TYPE long double + #define MOD_FUNCTION(a,b) fmodl((a),(b)) + #define GENERIC_COPY_FUNCTION copy_ldouble_to_uint + #define ldouble_to_uint NULL + #include "slarith.inc" + +/* (long double, long) */ + #if LONG_IS_NOT_INT + #define ldouble_long_bin_op NULL + #define GENERIC_A_TYPE long double + #define GENERIC_B_TYPE long + #define GENERIC_C_TYPE long double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) lpow((long double)(a),(long double)(b)) + #define POW_RESULT_TYPE long double + #define MOD_FUNCTION(a,b) fmodl((a),(b)) + #define GENERIC_COPY_FUNCTION copy_ldouble_to_long + #define ldouble_to_long NULL + #include "slarith.inc" + #else + #define ldouble_long_bin_op ldouble_int_bin_op + #define copy_ldouble_to_long copy_ldouble_to_int + #define ldouble_to_long ldouble_to_int + #endif /* LONG_IS_NOT_INT */ + +/* (long double, unsigned long) */ + #if LONG_IS_NOT_INT + #define ldouble_ulong_bin_op NULL + #define GENERIC_A_TYPE long double + #define GENERIC_B_TYPE unsigned long + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE long double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) lpow((long double)(a),(long double)(b)) + #define POW_RESULT_TYPE long double + #define MOD_FUNCTION(a,b) fmodl((a),(b)) + #define GENERIC_COPY_FUNCTION copy_ldouble_to_ulong + #define ldouble_to_ulong NULL + #include "slarith.inc" + #else + #define ldouble_ulong_bin_op ldouble_uint_bin_op + #define copy_ldouble_to_ulong copy_ldouble_to_uint + #define ldouble_to_ulong ldouble_to_uint + #endif /* LONG_IS_NOT_INT */ + +/* (long double, long long) */ + #if defined(HAVE_LONG_LONG) + #if LLONG_IS_NOT_LONG + #define ldouble_llong_bin_op NULL + #define GENERIC_A_TYPE long double + #define GENERIC_B_TYPE long long + #define GENERIC_C_TYPE long double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) lpow((long double)(a),(long double)(b)) + #define POW_RESULT_TYPE long double + #define MOD_FUNCTION(a,b) fmodl((a),(b)) + #define GENERIC_COPY_FUNCTION copy_ldouble_to_llong + #define ldouble_to_llong NULL + #include "slarith.inc" + #else + #define ldouble_llong_bin_op ldouble_long_bin_op + #define copy_ldouble_to_llong copy_ldouble_to_long + #define ldouble_to_llong ldouble_to_long + #endif /* LLONG_IS_NOT_LONG */ + #endif /* defined(HAVE_LONG_LONG) */ + +/* (long double, unsigned long long) */ + #if defined(HAVE_LONG_LONG) + #if LLONG_IS_NOT_LONG + #define ldouble_ullong_bin_op NULL + #define GENERIC_A_TYPE long double + #define GENERIC_B_TYPE unsigned long long + #define GENERIC_B_TYPE_UNSIGNED 1 + #define GENERIC_C_TYPE long double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) lpow((long double)(a),(long double)(b)) + #define POW_RESULT_TYPE long double + #define MOD_FUNCTION(a,b) fmodl((a),(b)) + #define GENERIC_COPY_FUNCTION copy_ldouble_to_ullong + #define ldouble_to_ullong NULL + #include "slarith.inc" + #else + #define ldouble_ullong_bin_op ldouble_ulong_bin_op + #define copy_ldouble_to_ullong copy_ldouble_to_ulong + #define ldouble_to_ullong ldouble_to_ulong + #endif /* LLONG_IS_NOT_LONG */ + #endif /* defined(HAVE_LONG_LONG) */ + +/* (long double, float) */ + #if SLANG_HAS_FLOAT + #define ldouble_float_bin_op NULL + #define GENERIC_A_TYPE long double + #define GENERIC_B_TYPE float + #define GENERIC_C_TYPE long double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) lpow((long double)(a),(long double)(b)) + #define POW_RESULT_TYPE long double + #define MOD_FUNCTION(a,b) fmodl((a),(b)) + #define GENERIC_COPY_FUNCTION copy_ldouble_to_float + #define ldouble_to_float NULL + #include "slarith.inc" + #endif /* SLANG_HAS_FLOAT */ + +/* (long double, double) */ + #if SLANG_HAS_FLOAT + #define GENERIC_BINARY_FUNCTION ldouble_double_bin_op + #define GENERIC_A_TYPE long double + #define GENERIC_B_TYPE double + #define GENERIC_C_TYPE long double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) lpow((long double)(a),(long double)(b)) + #define POW_RESULT_TYPE long double + #define MOD_FUNCTION(a,b) fmodl((a),(b)) + #define GENERIC_COPY_FUNCTION copy_ldouble_to_double + #define ldouble_to_double NULL + #include "slarith.inc" + #endif /* SLANG_HAS_FLOAT */ + +/* (long double, long double) */ + #define GENERIC_BINARY_FUNCTION ldouble_ldouble_bin_op + #define GENERIC_A_TYPE long double + #define GENERIC_B_TYPE long double + #define GENERIC_C_TYPE long double + #define TRAP_DIV_ZERO 0 + #define POW_FUNCTION(a,b) lpow((long double)(a),(long double)(b)) + #define POW_RESULT_TYPE long double + #define MOD_FUNCTION(a,b) fmodl((a),(b)) + #define SCALAR_BINARY_FUNCTION ldouble_ldouble_scalar_bin_op + #define PUSH_SCALAR_OBJ_FUN(a) SLclass_push_ldouble_obj(SLANG_LDOUBLE_TYPE, (long double)(a)) + #define PUSH_POW_OBJ_FUN(a) SLclass_push_ldouble_obj(SLANG_LDOUBLE_TYPE,(a)) + #define GENERIC_UNARY_FUNCTION ldouble_unary_op + #define ABS_FUNCTION(a) fabsl(a) + #define CMP_FUNCTION ldouble_cmp_function + #define TO_DOUBLE_FUNCTION ldouble_to_one_double + #define GENERIC_COPY_FUNCTION copy_ldouble_to_ldouble + #define ldouble_to_ldouble convert_self_to_self + #include "slarith.inc" + #endif /* defined(HAVE_LONG_DOUBLE) */ -#if SLANG_HAS_FLOAT -static To_Double_Fun_Table_Type To_Double_Fun_Table MAX_ARITHMETIC_TYPES = -{ - {sizeof(signed char), char_to_one_double}, - {sizeof(unsigned char), uchar_to_one_double}, - {sizeof(short), short_to_one_double}, - {sizeof(unsigned short), ushort_to_one_double}, - {sizeof(int), int_to_one_double}, - {sizeof(unsigned int), uint_to_one_double}, - {sizeof(long), long_to_one_double}, - {sizeof(unsigned long), ulong_to_one_double}, -#if defined(HAVE_LONG_LONG) - {sizeof(long long), llong_to_one_double}, -#else - {0, NULL}, -#endif -#if defined(HAVE_LONG_LONG) - {sizeof(unsigned long long), ullong_to_one_double}, -#else - {0, NULL}, -#endif -#if SLANG_HAS_FLOAT - {sizeof(float), float_to_one_double}, -#else - {0, NULL}, -#endif -#if SLANG_HAS_FLOAT - {sizeof(double), double_to_one_double}, -#else - {0, NULL}, -#endif -#if defined(HAVE_LONG_DOUBLE) - {sizeof(long double), ldouble_to_one_double}, -#else - {0, NULL}, -#endif -}; -#endif static Binary_Matrix_Type Binary_Matrix MAX_ARITHMETIC_TYPESMAX_ARITHMETIC_TYPES = { - /* signed char */ +/* signed char */ { - {(FVOID_STAR)copy_char_to_char, char_to_char}, - {(FVOID_STAR)copy_char_to_uchar, char_to_uchar}, - {(FVOID_STAR)copy_char_to_short, char_to_short}, - {(FVOID_STAR)copy_char_to_ushort, char_to_ushort}, - {(FVOID_STAR)copy_char_to_int, char_to_int}, - {(FVOID_STAR)copy_char_to_uint, char_to_uint}, - {(FVOID_STAR)copy_char_to_long, char_to_long}, - {(FVOID_STAR)copy_char_to_ulong, char_to_ulong}, + {(SLFvoid_Star)copy_char_to_char, char_to_char, char_char_bin_op}, + {(SLFvoid_Star)copy_char_to_uchar, char_to_uchar, char_uchar_bin_op}, + {(SLFvoid_Star)copy_char_to_short, char_to_short, char_short_bin_op}, + {(SLFvoid_Star)copy_char_to_ushort, char_to_ushort, char_ushort_bin_op}, + {(SLFvoid_Star)copy_char_to_int, char_to_int, char_int_bin_op}, + {(SLFvoid_Star)copy_char_to_uint, char_to_uint, char_uint_bin_op}, + {(SLFvoid_Star)copy_char_to_long, char_to_long, char_long_bin_op}, + {(SLFvoid_Star)copy_char_to_ulong, char_to_ulong, char_ulong_bin_op}, #if defined(HAVE_LONG_LONG) - {(FVOID_STAR)copy_char_to_llong, char_to_llong}, + {(SLFvoid_Star)copy_char_to_llong, char_to_llong, char_llong_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* defined(HAVE_LONG_LONG) */ #if defined(HAVE_LONG_LONG) - {(FVOID_STAR)copy_char_to_ullong, char_to_ullong}, + {(SLFvoid_Star)copy_char_to_ullong, char_to_ullong, char_ullong_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* defined(HAVE_LONG_LONG) */ #if SLANG_HAS_FLOAT - {(FVOID_STAR)copy_char_to_float, char_to_float}, + {(SLFvoid_Star)copy_char_to_float, char_to_float, char_float_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* SLANG_HAS_FLOAT */ #if SLANG_HAS_FLOAT - {(FVOID_STAR)copy_char_to_double, char_to_double}, + {(SLFvoid_Star)copy_char_to_double, char_to_double, char_double_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* SLANG_HAS_FLOAT */ #if defined(HAVE_LONG_DOUBLE) - {(FVOID_STAR)copy_char_to_ldouble, char_to_ldouble}, + {(SLFvoid_Star)copy_char_to_ldouble, char_to_ldouble, char_ldouble_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* defined(HAVE_LONG_DOUBLE) */ }, - /* unsigned char */ +/* unsigned char */ { - {(FVOID_STAR)copy_uchar_to_char, uchar_to_char}, - {(FVOID_STAR)copy_uchar_to_uchar, uchar_to_uchar}, - {(FVOID_STAR)copy_uchar_to_short, uchar_to_short}, - {(FVOID_STAR)copy_uchar_to_ushort, uchar_to_ushort}, - {(FVOID_STAR)copy_uchar_to_int, uchar_to_int}, - {(FVOID_STAR)copy_uchar_to_uint, uchar_to_uint}, - {(FVOID_STAR)copy_uchar_to_long, uchar_to_long}, - {(FVOID_STAR)copy_uchar_to_ulong, uchar_to_ulong}, + {(SLFvoid_Star)copy_uchar_to_char, uchar_to_char, uchar_char_bin_op}, + {(SLFvoid_Star)copy_uchar_to_uchar, uchar_to_uchar, uchar_uchar_bin_op}, + {(SLFvoid_Star)copy_uchar_to_short, uchar_to_short, uchar_short_bin_op}, + {(SLFvoid_Star)copy_uchar_to_ushort, uchar_to_ushort, uchar_ushort_bin_op}, + {(SLFvoid_Star)copy_uchar_to_int, uchar_to_int, uchar_int_bin_op}, + {(SLFvoid_Star)copy_uchar_to_uint, uchar_to_uint, uchar_uint_bin_op}, + {(SLFvoid_Star)copy_uchar_to_long, uchar_to_long, uchar_long_bin_op}, + {(SLFvoid_Star)copy_uchar_to_ulong, uchar_to_ulong, uchar_ulong_bin_op}, #if defined(HAVE_LONG_LONG) - {(FVOID_STAR)copy_uchar_to_llong, uchar_to_llong}, + {(SLFvoid_Star)copy_uchar_to_llong, uchar_to_llong, uchar_llong_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* defined(HAVE_LONG_LONG) */ #if defined(HAVE_LONG_LONG) - {(FVOID_STAR)copy_uchar_to_ullong, uchar_to_ullong}, + {(SLFvoid_Star)copy_uchar_to_ullong, uchar_to_ullong, uchar_ullong_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* defined(HAVE_LONG_LONG) */ #if SLANG_HAS_FLOAT - {(FVOID_STAR)copy_uchar_to_float, uchar_to_float}, + {(SLFvoid_Star)copy_uchar_to_float, uchar_to_float, uchar_float_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* SLANG_HAS_FLOAT */ #if SLANG_HAS_FLOAT - {(FVOID_STAR)copy_uchar_to_double, uchar_to_double}, + {(SLFvoid_Star)copy_uchar_to_double, uchar_to_double, uchar_double_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* SLANG_HAS_FLOAT */ #if defined(HAVE_LONG_DOUBLE) - {(FVOID_STAR)copy_uchar_to_ldouble, uchar_to_ldouble}, + {(SLFvoid_Star)copy_uchar_to_ldouble, uchar_to_ldouble, uchar_ldouble_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* defined(HAVE_LONG_DOUBLE) */ }, - /* short */ +/* short */ { - {(FVOID_STAR)copy_short_to_char, short_to_char}, - {(FVOID_STAR)copy_short_to_uchar, short_to_uchar}, - {(FVOID_STAR)copy_short_to_short, short_to_short}, - {(FVOID_STAR)copy_short_to_ushort, short_to_ushort}, - {(FVOID_STAR)copy_short_to_int, short_to_int}, - {(FVOID_STAR)copy_short_to_uint, short_to_uint}, - {(FVOID_STAR)copy_short_to_long, short_to_long}, - {(FVOID_STAR)copy_short_to_ulong, short_to_ulong}, + {(SLFvoid_Star)copy_short_to_char, short_to_char, short_char_bin_op}, + {(SLFvoid_Star)copy_short_to_uchar, short_to_uchar, short_uchar_bin_op}, + {(SLFvoid_Star)copy_short_to_short, short_to_short, short_short_bin_op}, + {(SLFvoid_Star)copy_short_to_ushort, short_to_ushort, short_ushort_bin_op}, + {(SLFvoid_Star)copy_short_to_int, short_to_int, short_int_bin_op}, + {(SLFvoid_Star)copy_short_to_uint, short_to_uint, short_uint_bin_op}, + {(SLFvoid_Star)copy_short_to_long, short_to_long, short_long_bin_op}, + {(SLFvoid_Star)copy_short_to_ulong, short_to_ulong, short_ulong_bin_op}, #if defined(HAVE_LONG_LONG) - {(FVOID_STAR)copy_short_to_llong, short_to_llong}, + {(SLFvoid_Star)copy_short_to_llong, short_to_llong, short_llong_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* defined(HAVE_LONG_LONG) */ #if defined(HAVE_LONG_LONG) - {(FVOID_STAR)copy_short_to_ullong, short_to_ullong}, + {(SLFvoid_Star)copy_short_to_ullong, short_to_ullong, short_ullong_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* defined(HAVE_LONG_LONG) */ #if SLANG_HAS_FLOAT - {(FVOID_STAR)copy_short_to_float, short_to_float}, + {(SLFvoid_Star)copy_short_to_float, short_to_float, short_float_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* SLANG_HAS_FLOAT */ #if SLANG_HAS_FLOAT - {(FVOID_STAR)copy_short_to_double, short_to_double}, + {(SLFvoid_Star)copy_short_to_double, short_to_double, short_double_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* SLANG_HAS_FLOAT */ #if defined(HAVE_LONG_DOUBLE) - {(FVOID_STAR)copy_short_to_ldouble, short_to_ldouble}, + {(SLFvoid_Star)copy_short_to_ldouble, short_to_ldouble, short_ldouble_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* defined(HAVE_LONG_DOUBLE) */ }, - /* unsigned short */ +/* unsigned short */ { - {(FVOID_STAR)copy_ushort_to_char, ushort_to_char}, - {(FVOID_STAR)copy_ushort_to_uchar, ushort_to_uchar}, - {(FVOID_STAR)copy_ushort_to_short, ushort_to_short}, - {(FVOID_STAR)copy_ushort_to_ushort, ushort_to_ushort}, - {(FVOID_STAR)copy_ushort_to_int, ushort_to_int}, - {(FVOID_STAR)copy_ushort_to_uint, ushort_to_uint}, - {(FVOID_STAR)copy_ushort_to_long, ushort_to_long}, - {(FVOID_STAR)copy_ushort_to_ulong, ushort_to_ulong}, + {(SLFvoid_Star)copy_ushort_to_char, ushort_to_char, ushort_char_bin_op}, + {(SLFvoid_Star)copy_ushort_to_uchar, ushort_to_uchar, ushort_uchar_bin_op}, + {(SLFvoid_Star)copy_ushort_to_short, ushort_to_short, ushort_short_bin_op}, + {(SLFvoid_Star)copy_ushort_to_ushort, ushort_to_ushort, ushort_ushort_bin_op}, + {(SLFvoid_Star)copy_ushort_to_int, ushort_to_int, ushort_int_bin_op}, + {(SLFvoid_Star)copy_ushort_to_uint, ushort_to_uint, ushort_uint_bin_op}, + {(SLFvoid_Star)copy_ushort_to_long, ushort_to_long, ushort_long_bin_op}, + {(SLFvoid_Star)copy_ushort_to_ulong, ushort_to_ulong, ushort_ulong_bin_op}, #if defined(HAVE_LONG_LONG) - {(FVOID_STAR)copy_ushort_to_llong, ushort_to_llong}, + {(SLFvoid_Star)copy_ushort_to_llong, ushort_to_llong, ushort_llong_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* defined(HAVE_LONG_LONG) */ #if defined(HAVE_LONG_LONG) - {(FVOID_STAR)copy_ushort_to_ullong, ushort_to_ullong}, + {(SLFvoid_Star)copy_ushort_to_ullong, ushort_to_ullong, ushort_ullong_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* defined(HAVE_LONG_LONG) */ #if SLANG_HAS_FLOAT - {(FVOID_STAR)copy_ushort_to_float, ushort_to_float}, + {(SLFvoid_Star)copy_ushort_to_float, ushort_to_float, ushort_float_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* SLANG_HAS_FLOAT */ #if SLANG_HAS_FLOAT - {(FVOID_STAR)copy_ushort_to_double, ushort_to_double}, + {(SLFvoid_Star)copy_ushort_to_double, ushort_to_double, ushort_double_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* SLANG_HAS_FLOAT */ #if defined(HAVE_LONG_DOUBLE) - {(FVOID_STAR)copy_ushort_to_ldouble, ushort_to_ldouble}, + {(SLFvoid_Star)copy_ushort_to_ldouble, ushort_to_ldouble, ushort_ldouble_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* defined(HAVE_LONG_DOUBLE) */ }, - /* int */ +/* int */ { - {(FVOID_STAR)copy_int_to_char, int_to_char}, - {(FVOID_STAR)copy_int_to_uchar, int_to_uchar}, - {(FVOID_STAR)copy_int_to_short, int_to_short}, - {(FVOID_STAR)copy_int_to_ushort, int_to_ushort}, - {(FVOID_STAR)copy_int_to_int, int_to_int}, - {(FVOID_STAR)copy_int_to_uint, int_to_uint}, - {(FVOID_STAR)copy_int_to_long, int_to_long}, - {(FVOID_STAR)copy_int_to_ulong, int_to_ulong}, + {(SLFvoid_Star)copy_int_to_char, int_to_char, int_char_bin_op}, + {(SLFvoid_Star)copy_int_to_uchar, int_to_uchar, int_uchar_bin_op}, + {(SLFvoid_Star)copy_int_to_short, int_to_short, int_short_bin_op}, + {(SLFvoid_Star)copy_int_to_ushort, int_to_ushort, int_ushort_bin_op}, + {(SLFvoid_Star)copy_int_to_int, int_to_int, int_int_bin_op}, + {(SLFvoid_Star)copy_int_to_uint, int_to_uint, int_uint_bin_op}, + {(SLFvoid_Star)copy_int_to_long, int_to_long, int_long_bin_op}, + {(SLFvoid_Star)copy_int_to_ulong, int_to_ulong, int_ulong_bin_op}, #if defined(HAVE_LONG_LONG) - {(FVOID_STAR)copy_int_to_llong, int_to_llong}, + {(SLFvoid_Star)copy_int_to_llong, int_to_llong, int_llong_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* defined(HAVE_LONG_LONG) */ #if defined(HAVE_LONG_LONG) - {(FVOID_STAR)copy_int_to_ullong, int_to_ullong}, + {(SLFvoid_Star)copy_int_to_ullong, int_to_ullong, int_ullong_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* defined(HAVE_LONG_LONG) */ #if SLANG_HAS_FLOAT - {(FVOID_STAR)copy_int_to_float, int_to_float}, + {(SLFvoid_Star)copy_int_to_float, int_to_float, int_float_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* SLANG_HAS_FLOAT */ #if SLANG_HAS_FLOAT - {(FVOID_STAR)copy_int_to_double, int_to_double}, + {(SLFvoid_Star)copy_int_to_double, int_to_double, int_double_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* SLANG_HAS_FLOAT */ #if defined(HAVE_LONG_DOUBLE) - {(FVOID_STAR)copy_int_to_ldouble, int_to_ldouble}, + {(SLFvoid_Star)copy_int_to_ldouble, int_to_ldouble, int_ldouble_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* defined(HAVE_LONG_DOUBLE) */ }, - /* unsigned int */ +/* unsigned int */ { - {(FVOID_STAR)copy_uint_to_char, uint_to_char}, - {(FVOID_STAR)copy_uint_to_uchar, uint_to_uchar}, - {(FVOID_STAR)copy_uint_to_short, uint_to_short}, - {(FVOID_STAR)copy_uint_to_ushort, uint_to_ushort}, - {(FVOID_STAR)copy_uint_to_int, uint_to_int}, - {(FVOID_STAR)copy_uint_to_uint, uint_to_uint}, - {(FVOID_STAR)copy_uint_to_long, uint_to_long}, - {(FVOID_STAR)copy_uint_to_ulong, uint_to_ulong}, + {(SLFvoid_Star)copy_uint_to_char, uint_to_char, uint_char_bin_op}, + {(SLFvoid_Star)copy_uint_to_uchar, uint_to_uchar, uint_uchar_bin_op}, + {(SLFvoid_Star)copy_uint_to_short, uint_to_short, uint_short_bin_op}, + {(SLFvoid_Star)copy_uint_to_ushort, uint_to_ushort, uint_ushort_bin_op}, + {(SLFvoid_Star)copy_uint_to_int, uint_to_int, uint_int_bin_op}, + {(SLFvoid_Star)copy_uint_to_uint, uint_to_uint, uint_uint_bin_op}, + {(SLFvoid_Star)copy_uint_to_long, uint_to_long, uint_long_bin_op}, + {(SLFvoid_Star)copy_uint_to_ulong, uint_to_ulong, uint_ulong_bin_op}, #if defined(HAVE_LONG_LONG) - {(FVOID_STAR)copy_uint_to_llong, uint_to_llong}, + {(SLFvoid_Star)copy_uint_to_llong, uint_to_llong, uint_llong_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* defined(HAVE_LONG_LONG) */ #if defined(HAVE_LONG_LONG) - {(FVOID_STAR)copy_uint_to_ullong, uint_to_ullong}, + {(SLFvoid_Star)copy_uint_to_ullong, uint_to_ullong, uint_ullong_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* defined(HAVE_LONG_LONG) */ #if SLANG_HAS_FLOAT - {(FVOID_STAR)copy_uint_to_float, uint_to_float}, + {(SLFvoid_Star)copy_uint_to_float, uint_to_float, uint_float_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* SLANG_HAS_FLOAT */ #if SLANG_HAS_FLOAT - {(FVOID_STAR)copy_uint_to_double, uint_to_double}, + {(SLFvoid_Star)copy_uint_to_double, uint_to_double, uint_double_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* SLANG_HAS_FLOAT */ #if defined(HAVE_LONG_DOUBLE) - {(FVOID_STAR)copy_uint_to_ldouble, uint_to_ldouble}, + {(SLFvoid_Star)copy_uint_to_ldouble, uint_to_ldouble, uint_ldouble_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* defined(HAVE_LONG_DOUBLE) */ }, - /* long */ +/* long */ { - {(FVOID_STAR)copy_long_to_char, long_to_char}, - {(FVOID_STAR)copy_long_to_uchar, long_to_uchar}, - {(FVOID_STAR)copy_long_to_short, long_to_short}, - {(FVOID_STAR)copy_long_to_ushort, long_to_ushort}, - {(FVOID_STAR)copy_long_to_int, long_to_int}, - {(FVOID_STAR)copy_long_to_uint, long_to_uint}, - {(FVOID_STAR)copy_long_to_long, long_to_long}, - {(FVOID_STAR)copy_long_to_ulong, long_to_ulong}, + {(SLFvoid_Star)copy_long_to_char, long_to_char, long_char_bin_op}, + {(SLFvoid_Star)copy_long_to_uchar, long_to_uchar, long_uchar_bin_op}, + {(SLFvoid_Star)copy_long_to_short, long_to_short, long_short_bin_op}, + {(SLFvoid_Star)copy_long_to_ushort, long_to_ushort, long_ushort_bin_op}, + {(SLFvoid_Star)copy_long_to_int, long_to_int, long_int_bin_op}, + {(SLFvoid_Star)copy_long_to_uint, long_to_uint, long_uint_bin_op}, + {(SLFvoid_Star)copy_long_to_long, long_to_long, long_long_bin_op}, + {(SLFvoid_Star)copy_long_to_ulong, long_to_ulong, long_ulong_bin_op}, #if defined(HAVE_LONG_LONG) - {(FVOID_STAR)copy_long_to_llong, long_to_llong}, + {(SLFvoid_Star)copy_long_to_llong, long_to_llong, long_llong_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* defined(HAVE_LONG_LONG) */ #if defined(HAVE_LONG_LONG) - {(FVOID_STAR)copy_long_to_ullong, long_to_ullong}, + {(SLFvoid_Star)copy_long_to_ullong, long_to_ullong, long_ullong_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* defined(HAVE_LONG_LONG) */ #if SLANG_HAS_FLOAT - {(FVOID_STAR)copy_long_to_float, long_to_float}, + {(SLFvoid_Star)copy_long_to_float, long_to_float, long_float_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* SLANG_HAS_FLOAT */ #if SLANG_HAS_FLOAT - {(FVOID_STAR)copy_long_to_double, long_to_double}, + {(SLFvoid_Star)copy_long_to_double, long_to_double, long_double_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* SLANG_HAS_FLOAT */ #if defined(HAVE_LONG_DOUBLE) - {(FVOID_STAR)copy_long_to_ldouble, long_to_ldouble}, + {(SLFvoid_Star)copy_long_to_ldouble, long_to_ldouble, long_ldouble_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* defined(HAVE_LONG_DOUBLE) */ }, - /* unsigned long */ +/* unsigned long */ { - {(FVOID_STAR)copy_ulong_to_char, ulong_to_char}, - {(FVOID_STAR)copy_ulong_to_uchar, ulong_to_uchar}, - {(FVOID_STAR)copy_ulong_to_short, ulong_to_short}, - {(FVOID_STAR)copy_ulong_to_ushort, ulong_to_ushort}, - {(FVOID_STAR)copy_ulong_to_int, ulong_to_int}, - {(FVOID_STAR)copy_ulong_to_uint, ulong_to_uint}, - {(FVOID_STAR)copy_ulong_to_long, ulong_to_long}, - {(FVOID_STAR)copy_ulong_to_ulong, ulong_to_ulong}, + {(SLFvoid_Star)copy_ulong_to_char, ulong_to_char, ulong_char_bin_op}, + {(SLFvoid_Star)copy_ulong_to_uchar, ulong_to_uchar, ulong_uchar_bin_op}, + {(SLFvoid_Star)copy_ulong_to_short, ulong_to_short, ulong_short_bin_op}, + {(SLFvoid_Star)copy_ulong_to_ushort, ulong_to_ushort, ulong_ushort_bin_op}, + {(SLFvoid_Star)copy_ulong_to_int, ulong_to_int, ulong_int_bin_op}, + {(SLFvoid_Star)copy_ulong_to_uint, ulong_to_uint, ulong_uint_bin_op}, + {(SLFvoid_Star)copy_ulong_to_long, ulong_to_long, ulong_long_bin_op}, + {(SLFvoid_Star)copy_ulong_to_ulong, ulong_to_ulong, ulong_ulong_bin_op}, #if defined(HAVE_LONG_LONG) - {(FVOID_STAR)copy_ulong_to_llong, ulong_to_llong}, + {(SLFvoid_Star)copy_ulong_to_llong, ulong_to_llong, ulong_llong_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* defined(HAVE_LONG_LONG) */ #if defined(HAVE_LONG_LONG) - {(FVOID_STAR)copy_ulong_to_ullong, ulong_to_ullong}, + {(SLFvoid_Star)copy_ulong_to_ullong, ulong_to_ullong, ulong_ullong_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* defined(HAVE_LONG_LONG) */ #if SLANG_HAS_FLOAT - {(FVOID_STAR)copy_ulong_to_float, ulong_to_float}, + {(SLFvoid_Star)copy_ulong_to_float, ulong_to_float, ulong_float_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* SLANG_HAS_FLOAT */ #if SLANG_HAS_FLOAT - {(FVOID_STAR)copy_ulong_to_double, ulong_to_double}, + {(SLFvoid_Star)copy_ulong_to_double, ulong_to_double, ulong_double_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* SLANG_HAS_FLOAT */ #if defined(HAVE_LONG_DOUBLE) - {(FVOID_STAR)copy_ulong_to_ldouble, ulong_to_ldouble}, + {(SLFvoid_Star)copy_ulong_to_ldouble, ulong_to_ldouble, ulong_ldouble_bin_op}, #else - {NULL, NULL}, -#endif + {NULL, NULL, NULL}, +#endif /* defined(HAVE_LONG_DOUBLE) */ }, - /* long long */ +/* long long */ #if defined(HAVE_LONG_LONG) { - {(FVOID_STAR)copy_llong_to_char, llong_to_char}, - {(FVOID_STAR)copy_llong_to_uchar, llong_to_uchar}, - {(FVOID_STAR)copy_llong_to_short, llong_to_short}, - {(FVOID_STAR)copy_llong_to_ushort, llong_to_ushort}, - {(FVOID_STAR)copy_llong_to_int, llong_to_int}, - {(FVOID_STAR)copy_llong_to_uint, llong_to_uint}, - {(FVOID_STAR)copy_llong_to_long, llong_to_long}, - {(FVOID_STAR)copy_llong_to_ulong, llong_to_ulong}, -#if defined(HAVE_LONG_LONG) - {(FVOID_STAR)copy_llong_to_llong, llong_to_llong}, -#else - {NULL, NULL}, -#endif -#if defined(HAVE_LONG_LONG) - {(FVOID_STAR)copy_llong_to_ullong, llong_to_ullong}, -#else - {NULL, NULL}, -#endif -#if SLANG_HAS_FLOAT - {(FVOID_STAR)copy_llong_to_float, llong_to_float}, -#else - {NULL, NULL}, -#endif -#if SLANG_HAS_FLOAT - {(FVOID_STAR)copy_llong_to_double, llong_to_double}, -#else - {NULL, NULL}, -#endif -#if defined(HAVE_LONG_DOUBLE) - {(FVOID_STAR)copy_llong_to_ldouble, llong_to_ldouble}, -#else - {NULL, NULL}, -#endif + {(SLFvoid_Star)copy_llong_to_char, llong_to_char, llong_char_bin_op}, + {(SLFvoid_Star)copy_llong_to_uchar, llong_to_uchar, llong_uchar_bin_op}, + {(SLFvoid_Star)copy_llong_to_short, llong_to_short, llong_short_bin_op}, + {(SLFvoid_Star)copy_llong_to_ushort, llong_to_ushort, llong_ushort_bin_op}, + {(SLFvoid_Star)copy_llong_to_int, llong_to_int, llong_int_bin_op}, + {(SLFvoid_Star)copy_llong_to_uint, llong_to_uint, llong_uint_bin_op}, + {(SLFvoid_Star)copy_llong_to_long, llong_to_long, llong_long_bin_op}, + {(SLFvoid_Star)copy_llong_to_ulong, llong_to_ulong, llong_ulong_bin_op}, + #if defined(HAVE_LONG_LONG) + {(SLFvoid_Star)copy_llong_to_llong, llong_to_llong, llong_llong_bin_op}, + #else + {NULL, NULL, NULL}, + #endif /* defined(HAVE_LONG_LONG) */ + #if defined(HAVE_LONG_LONG) + {(SLFvoid_Star)copy_llong_to_ullong, llong_to_ullong, llong_ullong_bin_op}, + #else + {NULL, NULL, NULL}, + #endif /* defined(HAVE_LONG_LONG) */ + #if SLANG_HAS_FLOAT + {(SLFvoid_Star)copy_llong_to_float, llong_to_float, llong_float_bin_op}, + #else + {NULL, NULL, NULL}, + #endif /* SLANG_HAS_FLOAT */ + #if SLANG_HAS_FLOAT + {(SLFvoid_Star)copy_llong_to_double, llong_to_double, llong_double_bin_op}, + #else + {NULL, NULL, NULL}, + #endif /* SLANG_HAS_FLOAT */ + #if defined(HAVE_LONG_DOUBLE) + {(SLFvoid_Star)copy_llong_to_ldouble, llong_to_ldouble, llong_ldouble_bin_op}, + #else + {NULL, NULL, NULL}, + #endif /* defined(HAVE_LONG_DOUBLE) */ }, #else { - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, }, #endif /* defined(HAVE_LONG_LONG) */ - - /* unsigned long long */ +/* unsigned long long */ #if defined(HAVE_LONG_LONG) { - {(FVOID_STAR)copy_ullong_to_char, ullong_to_char}, - {(FVOID_STAR)copy_ullong_to_uchar, ullong_to_uchar}, - {(FVOID_STAR)copy_ullong_to_short, ullong_to_short}, - {(FVOID_STAR)copy_ullong_to_ushort, ullong_to_ushort}, - {(FVOID_STAR)copy_ullong_to_int, ullong_to_int}, - {(FVOID_STAR)copy_ullong_to_uint, ullong_to_uint}, - {(FVOID_STAR)copy_ullong_to_long, ullong_to_long}, - {(FVOID_STAR)copy_ullong_to_ulong, ullong_to_ulong}, -#if defined(HAVE_LONG_LONG) - {(FVOID_STAR)copy_ullong_to_llong, ullong_to_llong}, -#else - {NULL, NULL}, -#endif -#if defined(HAVE_LONG_LONG) - {(FVOID_STAR)copy_ullong_to_ullong, ullong_to_ullong}, -#else - {NULL, NULL}, -#endif -#if SLANG_HAS_FLOAT - {(FVOID_STAR)copy_ullong_to_float, ullong_to_float}, -#else - {NULL, NULL}, -#endif -#if SLANG_HAS_FLOAT - {(FVOID_STAR)copy_ullong_to_double, ullong_to_double}, -#else - {NULL, NULL}, -#endif -#if defined(HAVE_LONG_DOUBLE) - {(FVOID_STAR)copy_ullong_to_ldouble, ullong_to_ldouble}, -#else - {NULL, NULL}, -#endif + {(SLFvoid_Star)copy_ullong_to_char, ullong_to_char, ullong_char_bin_op}, + {(SLFvoid_Star)copy_ullong_to_uchar, ullong_to_uchar, ullong_uchar_bin_op}, + {(SLFvoid_Star)copy_ullong_to_short, ullong_to_short, ullong_short_bin_op}, + {(SLFvoid_Star)copy_ullong_to_ushort, ullong_to_ushort, ullong_ushort_bin_op}, + {(SLFvoid_Star)copy_ullong_to_int, ullong_to_int, ullong_int_bin_op}, + {(SLFvoid_Star)copy_ullong_to_uint, ullong_to_uint, ullong_uint_bin_op}, + {(SLFvoid_Star)copy_ullong_to_long, ullong_to_long, ullong_long_bin_op}, + {(SLFvoid_Star)copy_ullong_to_ulong, ullong_to_ulong, ullong_ulong_bin_op}, + #if defined(HAVE_LONG_LONG) + {(SLFvoid_Star)copy_ullong_to_llong, ullong_to_llong, ullong_llong_bin_op}, + #else + {NULL, NULL, NULL}, + #endif /* defined(HAVE_LONG_LONG) */ + #if defined(HAVE_LONG_LONG) + {(SLFvoid_Star)copy_ullong_to_ullong, ullong_to_ullong, ullong_ullong_bin_op}, + #else + {NULL, NULL, NULL}, + #endif /* defined(HAVE_LONG_LONG) */ + #if SLANG_HAS_FLOAT + {(SLFvoid_Star)copy_ullong_to_float, ullong_to_float, ullong_float_bin_op}, + #else + {NULL, NULL, NULL}, + #endif /* SLANG_HAS_FLOAT */ + #if SLANG_HAS_FLOAT + {(SLFvoid_Star)copy_ullong_to_double, ullong_to_double, ullong_double_bin_op}, + #else + {NULL, NULL, NULL}, + #endif /* SLANG_HAS_FLOAT */ + #if defined(HAVE_LONG_DOUBLE) + {(SLFvoid_Star)copy_ullong_to_ldouble, ullong_to_ldouble, ullong_ldouble_bin_op}, + #else + {NULL, NULL, NULL}, + #endif /* defined(HAVE_LONG_DOUBLE) */ }, #else { - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, }, #endif /* defined(HAVE_LONG_LONG) */ - - /* float */ +/* float */ #if SLANG_HAS_FLOAT { - {(FVOID_STAR)copy_float_to_char, float_to_char}, - {(FVOID_STAR)copy_float_to_uchar, float_to_uchar}, - {(FVOID_STAR)copy_float_to_short, float_to_short}, - {(FVOID_STAR)copy_float_to_ushort, float_to_ushort}, - {(FVOID_STAR)copy_float_to_int, float_to_int}, - {(FVOID_STAR)copy_float_to_uint, float_to_uint}, - {(FVOID_STAR)copy_float_to_long, float_to_long}, - {(FVOID_STAR)copy_float_to_ulong, float_to_ulong}, -#if defined(HAVE_LONG_LONG) - {(FVOID_STAR)copy_float_to_llong, float_to_llong}, -#else - {NULL, NULL}, -#endif -#if defined(HAVE_LONG_LONG) - {(FVOID_STAR)copy_float_to_ullong, float_to_ullong}, -#else - {NULL, NULL}, -#endif -#if SLANG_HAS_FLOAT - {(FVOID_STAR)copy_float_to_float, float_to_float}, -#else - {NULL, NULL}, -#endif -#if SLANG_HAS_FLOAT - {(FVOID_STAR)copy_float_to_double, float_to_double}, -#else - {NULL, NULL}, -#endif -#if defined(HAVE_LONG_DOUBLE) - {(FVOID_STAR)copy_float_to_ldouble, float_to_ldouble}, -#else - {NULL, NULL}, -#endif + {(SLFvoid_Star)copy_float_to_char, float_to_char, float_char_bin_op}, + {(SLFvoid_Star)copy_float_to_uchar, float_to_uchar, float_uchar_bin_op}, + {(SLFvoid_Star)copy_float_to_short, float_to_short, float_short_bin_op}, + {(SLFvoid_Star)copy_float_to_ushort, float_to_ushort, float_ushort_bin_op}, + {(SLFvoid_Star)copy_float_to_int, float_to_int, float_int_bin_op}, + {(SLFvoid_Star)copy_float_to_uint, float_to_uint, float_uint_bin_op}, + {(SLFvoid_Star)copy_float_to_long, float_to_long, float_long_bin_op}, + {(SLFvoid_Star)copy_float_to_ulong, float_to_ulong, float_ulong_bin_op}, + #if defined(HAVE_LONG_LONG) + {(SLFvoid_Star)copy_float_to_llong, float_to_llong, float_llong_bin_op}, + #else + {NULL, NULL, NULL}, + #endif /* defined(HAVE_LONG_LONG) */ + #if defined(HAVE_LONG_LONG) + {(SLFvoid_Star)copy_float_to_ullong, float_to_ullong, float_ullong_bin_op}, + #else + {NULL, NULL, NULL}, + #endif /* defined(HAVE_LONG_LONG) */ + #if SLANG_HAS_FLOAT + {(SLFvoid_Star)copy_float_to_float, float_to_float, float_float_bin_op}, + #else + {NULL, NULL, NULL}, + #endif /* SLANG_HAS_FLOAT */ + #if SLANG_HAS_FLOAT + {(SLFvoid_Star)copy_float_to_double, float_to_double, float_double_bin_op}, + #else + {NULL, NULL, NULL}, + #endif /* SLANG_HAS_FLOAT */ + #if defined(HAVE_LONG_DOUBLE) + {(SLFvoid_Star)copy_float_to_ldouble, float_to_ldouble, float_ldouble_bin_op}, + #else + {NULL, NULL, NULL}, + #endif /* defined(HAVE_LONG_DOUBLE) */ }, #else { - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, }, #endif /* SLANG_HAS_FLOAT */ - - /* double */ +/* double */ #if SLANG_HAS_FLOAT { - {(FVOID_STAR)copy_double_to_char, double_to_char}, - {(FVOID_STAR)copy_double_to_uchar, double_to_uchar}, - {(FVOID_STAR)copy_double_to_short, double_to_short}, - {(FVOID_STAR)copy_double_to_ushort, double_to_ushort}, - {(FVOID_STAR)copy_double_to_int, double_to_int}, - {(FVOID_STAR)copy_double_to_uint, double_to_uint}, - {(FVOID_STAR)copy_double_to_long, double_to_long}, - {(FVOID_STAR)copy_double_to_ulong, double_to_ulong}, -#if defined(HAVE_LONG_LONG) - {(FVOID_STAR)copy_double_to_llong, double_to_llong}, -#else - {NULL, NULL}, -#endif -#if defined(HAVE_LONG_LONG) - {(FVOID_STAR)copy_double_to_ullong, double_to_ullong}, -#else - {NULL, NULL}, -#endif -#if SLANG_HAS_FLOAT - {(FVOID_STAR)copy_double_to_float, double_to_float}, -#else - {NULL, NULL}, -#endif -#if SLANG_HAS_FLOAT - {(FVOID_STAR)copy_double_to_double, double_to_double}, -#else - {NULL, NULL}, -#endif -#if defined(HAVE_LONG_DOUBLE) - {(FVOID_STAR)copy_double_to_ldouble, double_to_ldouble}, -#else - {NULL, NULL}, -#endif + {(SLFvoid_Star)copy_double_to_char, double_to_char, double_char_bin_op}, + {(SLFvoid_Star)copy_double_to_uchar, double_to_uchar, double_uchar_bin_op}, + {(SLFvoid_Star)copy_double_to_short, double_to_short, double_short_bin_op}, + {(SLFvoid_Star)copy_double_to_ushort, double_to_ushort, double_ushort_bin_op}, + {(SLFvoid_Star)copy_double_to_int, double_to_int, double_int_bin_op}, + {(SLFvoid_Star)copy_double_to_uint, double_to_uint, double_uint_bin_op}, + {(SLFvoid_Star)copy_double_to_long, double_to_long, double_long_bin_op}, + {(SLFvoid_Star)copy_double_to_ulong, double_to_ulong, double_ulong_bin_op}, + #if defined(HAVE_LONG_LONG) + {(SLFvoid_Star)copy_double_to_llong, double_to_llong, double_llong_bin_op}, + #else + {NULL, NULL, NULL}, + #endif /* defined(HAVE_LONG_LONG) */ + #if defined(HAVE_LONG_LONG) + {(SLFvoid_Star)copy_double_to_ullong, double_to_ullong, double_ullong_bin_op}, + #else + {NULL, NULL, NULL}, + #endif /* defined(HAVE_LONG_LONG) */ + #if SLANG_HAS_FLOAT + {(SLFvoid_Star)copy_double_to_float, double_to_float, double_float_bin_op}, + #else + {NULL, NULL, NULL}, + #endif /* SLANG_HAS_FLOAT */ + #if SLANG_HAS_FLOAT + {(SLFvoid_Star)copy_double_to_double, double_to_double, double_double_bin_op}, + #else + {NULL, NULL, NULL}, + #endif /* SLANG_HAS_FLOAT */ + #if defined(HAVE_LONG_DOUBLE) + {(SLFvoid_Star)copy_double_to_ldouble, double_to_ldouble, double_ldouble_bin_op}, + #else + {NULL, NULL, NULL}, + #endif /* defined(HAVE_LONG_DOUBLE) */ }, #else { - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, }, #endif /* SLANG_HAS_FLOAT */ - - /* long double */ +/* long double */ #if defined(HAVE_LONG_DOUBLE) { - {(FVOID_STAR)copy_ldouble_to_char, ldouble_to_char}, - {(FVOID_STAR)copy_ldouble_to_uchar, ldouble_to_uchar}, - {(FVOID_STAR)copy_ldouble_to_short, ldouble_to_short}, - {(FVOID_STAR)copy_ldouble_to_ushort, ldouble_to_ushort}, - {(FVOID_STAR)copy_ldouble_to_int, ldouble_to_int}, - {(FVOID_STAR)copy_ldouble_to_uint, ldouble_to_uint}, - {(FVOID_STAR)copy_ldouble_to_long, ldouble_to_long}, - {(FVOID_STAR)copy_ldouble_to_ulong, ldouble_to_ulong}, -#if defined(HAVE_LONG_LONG) - {(FVOID_STAR)copy_ldouble_to_llong, ldouble_to_llong}, -#else - {NULL, NULL}, -#endif -#if defined(HAVE_LONG_LONG) - {(FVOID_STAR)copy_ldouble_to_ullong, ldouble_to_ullong}, -#else - {NULL, NULL}, -#endif -#if SLANG_HAS_FLOAT - {(FVOID_STAR)copy_ldouble_to_float, ldouble_to_float}, -#else - {NULL, NULL}, -#endif -#if SLANG_HAS_FLOAT - {(FVOID_STAR)copy_ldouble_to_double, ldouble_to_double}, -#else - {NULL, NULL}, -#endif -#if defined(HAVE_LONG_DOUBLE) - {(FVOID_STAR)copy_ldouble_to_ldouble, ldouble_to_ldouble}, -#else - {NULL, NULL}, -#endif + {(SLFvoid_Star)copy_ldouble_to_char, ldouble_to_char, ldouble_char_bin_op}, + {(SLFvoid_Star)copy_ldouble_to_uchar, ldouble_to_uchar, ldouble_uchar_bin_op}, + {(SLFvoid_Star)copy_ldouble_to_short, ldouble_to_short, ldouble_short_bin_op}, + {(SLFvoid_Star)copy_ldouble_to_ushort, ldouble_to_ushort, ldouble_ushort_bin_op}, + {(SLFvoid_Star)copy_ldouble_to_int, ldouble_to_int, ldouble_int_bin_op}, + {(SLFvoid_Star)copy_ldouble_to_uint, ldouble_to_uint, ldouble_uint_bin_op}, + {(SLFvoid_Star)copy_ldouble_to_long, ldouble_to_long, ldouble_long_bin_op}, + {(SLFvoid_Star)copy_ldouble_to_ulong, ldouble_to_ulong, ldouble_ulong_bin_op}, + #if defined(HAVE_LONG_LONG) + {(SLFvoid_Star)copy_ldouble_to_llong, ldouble_to_llong, ldouble_llong_bin_op}, + #else + {NULL, NULL, NULL}, + #endif /* defined(HAVE_LONG_LONG) */ + #if defined(HAVE_LONG_LONG) + {(SLFvoid_Star)copy_ldouble_to_ullong, ldouble_to_ullong, ldouble_ullong_bin_op}, + #else + {NULL, NULL, NULL}, + #endif /* defined(HAVE_LONG_LONG) */ + #if SLANG_HAS_FLOAT + {(SLFvoid_Star)copy_ldouble_to_float, ldouble_to_float, ldouble_float_bin_op}, + #else + {NULL, NULL, NULL}, + #endif /* SLANG_HAS_FLOAT */ + #if SLANG_HAS_FLOAT + {(SLFvoid_Star)copy_ldouble_to_double, ldouble_to_double, ldouble_double_bin_op}, + #else + {NULL, NULL, NULL}, + #endif /* SLANG_HAS_FLOAT */ + #if defined(HAVE_LONG_DOUBLE) + {(SLFvoid_Star)copy_ldouble_to_ldouble, ldouble_to_ldouble, ldouble_ldouble_bin_op}, + #else + {NULL, NULL, NULL}, + #endif /* defined(HAVE_LONG_DOUBLE) */ }, #else { - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, - {NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, + {NULL, NULL, NULL}, }, #endif /* defined(HAVE_LONG_DOUBLE) */ +}; +#if SLANG_HAS_FLOAT +static To_Double_Fun_Table_Type To_Double_Fun_Table MAX_ARITHMETIC_TYPES = +{ + {sizeof(signed char), char_to_one_double}, + {sizeof(unsigned char), uchar_to_one_double}, + {sizeof(short), short_to_one_double}, + {sizeof(unsigned short), ushort_to_one_double}, + {sizeof(int), int_to_one_double}, + {sizeof(unsigned int), uint_to_one_double}, + {sizeof(long), long_to_one_double}, + {sizeof(unsigned long), ulong_to_one_double}, + #if defined(HAVE_LONG_LONG) + {sizeof(long long), llong_to_one_double}, + #else + {0, NULL}, + #endif /* defined(HAVE_LONG_LONG) */ + #if defined(HAVE_LONG_LONG) + {sizeof(unsigned long long), ullong_to_one_double}, + #else + {0, NULL}, + #endif /* defined(HAVE_LONG_LONG) */ + #if SLANG_HAS_FLOAT + {sizeof(float), float_to_one_double}, + #else + {0, NULL}, + #endif /* SLANG_HAS_FLOAT */ + #if SLANG_HAS_FLOAT + {sizeof(double), double_to_one_double}, + #else + {0, NULL}, + #endif /* SLANG_HAS_FLOAT */ + #if defined(HAVE_LONG_DOUBLE) + {sizeof(long double), ldouble_to_one_double}, + #else + {0, NULL}, + #endif /* defined(HAVE_LONG_DOUBLE) */ }; +#endif /* SLANG_HAS_FLOAT */
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slarray.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slarray.c
Changed
@@ -1,6 +1,6 @@ /* Array manipulation routines for S-Lang */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -22,6 +22,7 @@ #include "slinclud.h" #include <math.h> +#include <limits.h> /* #define SL_APP_WANTS_FOREACH */ #include "slang.h" @@ -61,7 +62,7 @@ case SLANG_NULL_TYPE: /* convert_scalar = 0; */ /* commented out for 2.0.5 to fix array_map NULL bug */ - /* drop */ + /* fall through */ default: if (convert_scalar == 0) { @@ -123,19 +124,18 @@ ofs = 0; for (i = 0; i < num_dims; i++) { - size_t new_ofs; SLindex_Type d = dimsi; - if (d < 0) - d = d + max_dimsi; - - new_ofs = ofs * (size_t)max_dims i + (size_t) d; - if ((max_dimsi != 0) - && ((new_ofs - (size_t)d)/max_dimsi != ofs)) + if ((d < 0) || (d >= max_dimsi)) { - throw_size_error (SL_Index_Error); - return NULL; + if (d < 0) + d = d + max_dimsi; + if ((d < 0) || (d >= max_dimsi)) + { + SLang_set_error (SL_Index_Error); + return NULL; + } } - ofs = new_ofs; + ofs = ofs * (size_t)max_dims i + (size_t) d; } } if (ofs >= at->num_elements) @@ -231,7 +231,8 @@ return (*at->cl->cl_init_array_object) (at->data_type, data); } -int _pSLarray_next_index (SLindex_Type *dims, SLindex_Type *max_dims, unsigned int num_dims) +static int next_index (SLindex_Type *dims, SLindex_Type *max_dims, + unsigned int num_dims, unsigned int *changed_indexp) { while (num_dims) { @@ -240,9 +241,10 @@ num_dims--; dims_i = dims num_dims + 1; - if (dims_i < (int) max_dims num_dims) + if (dims_i < (SLindex_Type) max_dims num_dims) { dims num_dims = dims_i; + *changed_indexp = num_dims; return 0; } dims num_dims = 0; @@ -251,6 +253,12 @@ return -1; } +int _pSLarray_next_index (SLindex_Type *dims, SLindex_Type *max_dims, unsigned int num_dims) +{ + unsigned int changed_index; + return next_index (dims, max_dims, num_dims, &changed_index); +} + static int do_method_for_all_elements (SLang_Array_Type *at, int (*method)(SLang_Array_Type *, SLindex_Type *, @@ -259,7 +267,7 @@ { SLindex_Type dims SLARRAY_MAX_DIMS; SLindex_Type *max_dims; - unsigned int num_dims; + unsigned int num_dims, changed_index; if (at->num_elements == 0) return 0; @@ -274,7 +282,7 @@ if (-1 == (*method) (at, dims, client_data)) return -1; } - while (0 == _pSLarray_next_index (dims, max_dims, num_dims)); + while (0 == next_index (dims, max_dims, num_dims, &changed_index)); return 0; } @@ -312,6 +320,26 @@ free_array (at); } +/* Here, a and b are assumed to be non-negative */ +static int check_overflow_mult_i (SLindex_Type a, SLindex_Type b, SLindex_Type *cp) +{ + if ((a < 0) || (b < 0) || ((b > 0) && (a > INT_MAX/b))) + return -1; + + *cp = a*b; + + return 0; +} + +static int check_overflow_mult_ui (SLuindex_Type a, SLindex_Type b, SLuindex_Type *cp) +{ + if ((b < 0) || ((b > 0) && (a > UINT_MAX/(SLuindex_Type)b))) + return -1; + + *cp = a*(SLuindex_Type)b; + return 0; +} + SLang_Array_Type * SLang_create_array1 (SLtype type, int read_only, VOID_STAR data, SLindex_Type *dims, unsigned int num_dims, int no_init) @@ -366,16 +394,14 @@ num_elements = 1; for (i = 0; i < num_dims; i++) { - SLindex_Type new_num_elements; at->dimsi = dimsi; - new_num_elements = dimsi * num_elements; - if (dimsi && (new_num_elements/dimsi != num_elements)) + + if (-1 == check_overflow_mult_i (num_elements, dimsi, &num_elements)) { throw_size_error (SL_Index_Error); free_array (at); return NULL; } - num_elements = new_num_elements; } /* Now set the rest of the unused dimensions to 1. This makes it easier @@ -395,10 +421,12 @@ return at; } - size = (num_elements * sizeof_type); - if ((size/sizeof_type != num_elements) || (size < 0)) + /* SLmalloc is currently limited to the use of unsigned integers. + * So include the size of the type as well. + */ + if (-1 == check_overflow_mult_i (num_elements, sizeof_type, &size)) { - throw_size_error (SL_INVALID_PARM); + throw_size_error (SL_Index_Error); free_array (at); return NULL; } @@ -563,7 +591,7 @@ } imax = at->num_elements; - + vdata = (VOID_STAR) _SLcalloc (imax, at->sizeof_type); if (vdata == NULL) return -1; @@ -588,6 +616,13 @@ } } +static void do_index_error (SLuindex_Type i, SLindex_Type n) +{ + _pSLang_verror (SL_Index_Error, "Array index %lu out of allowed range 0<=index<%ld", + (unsigned long)i, (long)n); +} + + /* If *is_index_array!=0, then only one index object is returned, which is * to index all the elements, and not just a single dimension. */ @@ -655,6 +690,7 @@ SLindex_Type first_index, last_index; SLindex_Type delta = r->delta; SLindex_Type n; + int ok = 1; if (num_indices == 1)/* could be index array */ n = (SLindex_Type)num_elements; @@ -666,15 +702,27 @@ /* Case 3 */ first_index = r->first_index; if (first_index < 0) first_index += n; - if (delta > 0) last_index = n-1; else last_index = 0; + if (delta > 0) + { + last_index = n-1; /* -i:n-1 not ok */ + ok = (first_index >= 0); + } + else + last_index = 0; /* -i:0:-1 ==> empty array, which is ok */ } else if (r->has_last_index) { /* case 2 */ - if (delta > 0) first_index = 0; else first_index = n-1; last_index = r->last_index; if (last_index < 0) last_index += n; + if (delta > 0) + first_index = 0; /* 0:-i:1 ==> empty, which is ok */ + else + { + first_index = n-1; + ok = (last_index >= 0); /* n:-i: -1 not ok */ + } } else { @@ -691,6 +739,12 @@ } } + if (!ok) + { + do_index_error (i, n); + goto return_error; + } + if (NULL == (new_at = inline_implicit_index_array (&first_index, &last_index, &delta))) goto return_error; @@ -711,12 +765,6 @@ return -1; } -static void do_index_error (SLuindex_Type i, SLindex_Type indx, SLindex_Type dim) -{ - _pSLang_verror (SL_Index_Error, "Array index %lu (value=%ld) out of allowed range 0<=index<%ld", - (unsigned long)i, (long)indx, (long)dim); -} - int _pSLarray_pop_index (unsigned int num_elements, SLang_Array_Type **ind_atp, SLindex_Type *ind) { SLang_Object_Type index_obj; @@ -870,6 +918,47 @@ return 0; } +#define CHECK_INDEX(_i,_n,_then) \ + if ((_i) < 0) \ + { \ + (_i) += (_n); \ + if ((_i) < 0) (_i) = (_n); \ + } \ + if ((_i) >= (_n)) \ + { \ + do_index_error((_i),(_n)); \ + _then; \ + }(void)0 + +/* Check that 0 <= | idx, idx + 1*delta, ..., idx + jmax-1 | <= num_elements + * If jmax == 0, then there are no indices to check. + */ +static int check_range_indices (SLindex_Type idx, SLindex_Type delta, SLindex_Type jmax, + SLindex_Type num_elements, int *isposp) +{ + SLindex_Type idx_0, idx_1; + + if (jmax == 0) + { + if (isposp != NULL) *isposp = 1; + return 0; + } + + idx_0 = idx; + idx_1 = idx + delta*(jmax-1); + + if ((idx_0 >= num_elements) || (idx_1 >= num_elements)) + { + SLang_set_error (SL_Index_Error); + return -1; + } + + if (isposp != NULL) *isposp = (idx_0 >= 0) && (idx_1 >= 0); + CHECK_INDEX(idx_0, num_elements, return -1); + CHECK_INDEX(idx_1, num_elements, return -1); + return 0; +} + #if SLANG_OPTIMIZE_FOR_SPEED # if SLANG_HAS_FLOAT # define GENERIC_TYPE double @@ -921,22 +1010,15 @@ SLindex_Type idx = r->first_index, delta = r->delta; SLuindex_Type j, jmax = at_ind->num_elements; + if (-1 == check_range_indices (idx, delta, jmax, num_elements, NULL)) + return -1; + for (j = 0; j < jmax; j++) { size_t offset; SLindex_Type i = idx; - if (i < 0) - { - i += num_elements; - if (i < 0) - i = num_elements; - } - if (i >= num_elements) - { - SLang_set_error (SL_Index_Error); - return -1; - } + if (i < 0) i += num_elements; offset = sizeof_type * (SLuindex_Type)i; if (-1 == transfer_n_elements (at, (VOID_STAR) dest_data, (VOID_STAR) (src_data + offset), @@ -946,6 +1028,7 @@ dest_data += sizeof_type; idx += delta; } + return 0; } @@ -957,18 +1040,7 @@ size_t offset; SLindex_Type i = *indices; - if (i < 0) - { - i += num_elements; - if (i < 0) - i = num_elements; - } - if (i >= num_elements) - { - SLang_set_error (SL_Index_Error); - return -1; - } - + CHECK_INDEX(i, num_elements, return -1); offset = sizeof_type * (SLuindex_Type)i; if (-1 == transfer_n_elements (at, (VOID_STAR) dest_data, (VOID_STAR) (src_data + offset), @@ -1050,7 +1122,7 @@ case SLANG_LONG_TYPE: case SLANG_ULONG_TYPE: - /* drop */ + /* fall through */ # if LONG_IS_NOT_INT if (-1 == aget_longs_from_index_array ((long *)src_data, num_elements, ind_at, is_range, (long *)new_data)) @@ -1063,7 +1135,7 @@ ind_at, is_range, (int *)new_data)) goto return_error; break; -#endif +#endif /* SLANG_OPTIMIZE_FOR_SPEED */ default: if (-1 == aget_generic_from_index_array (at, ind_at, is_range, new_data)) goto return_error; @@ -1103,7 +1175,6 @@ total_num_elements = 1; for (i = 0; i < num_indices; i++) { - SLuindex_Type new_total_num_elements; SLang_Object_Type *obj = index_objs + i; range_delta_buf i = 0; @@ -1145,13 +1216,11 @@ } } - new_total_num_elements = total_num_elements * max_dimsi; - if (max_dimsi && (new_total_num_elements/max_dimsi != total_num_elements)) + if (-1 == check_overflow_mult_ui (total_num_elements, max_dimsi, &total_num_elements)) { - throw_size_error (SL_INVALID_PARM); + throw_size_error (SL_Index_Error); return -1; } - total_num_elements = new_total_num_elements; } *num_elements = total_num_elements; @@ -1171,18 +1240,20 @@ SLindex_Type range_buf SLARRAY_MAX_DIMS; SLindex_Type range_delta_buf SLARRAY_MAX_DIMS; SLindex_Type max_dims SLARRAY_MAX_DIMS; - SLuindex_Type i, num_elements; + SLuindex_Type num_elements; SLang_Array_Type *new_at; SLindex_Type map_indicesSLARRAY_MAX_DIMS; SLindex_Type indices SLARRAY_MAX_DIMS; SLindex_Type *at_dims; size_t sizeof_type; + unsigned int i, last_changed_index; int is_ptr, ret, is_array; char *new_data; SLang_Class_Type *cl; int is_dim_arraySLARRAY_MAX_DIMS; SLuindex_Type last_index; SLindex_Type last_index_num; + int fast_ok = 0; if (-1 == convert_nasty_index_objs (at, index_objs, num_indices, index_data, range_buf, range_delta_buf, @@ -1224,11 +1295,15 @@ if ((range_delta_buflast_index == 1) && (range_buflast_index >= 0)) last_index_num = max_dimslast_index; else - last_index_num = 0; + { + last_index_num = 0; + fast_ok = ((is_ptr == 0) && (at->index_fun == linear_get_data_addr)); + } + last_changed_index = 0; while (1) { - for (i = 0; i < num_indices; i++) + for (i = last_changed_index; i < num_indices; i++) { SLindex_Type j = map_indicesi; SLindex_Type indx; @@ -1238,15 +1313,7 @@ else indx = index_data ij; - if (indx < 0) - indx += at_dimsi; - - if ((indx < 0) || (indx >= at_dimsi)) - { - do_index_error (i, indx, at_dimsi); - free_array (new_at); - return -1; - } + CHECK_INDEX (indx, at_dimsi, free_array(new_at); return -1); indicesi = indx; } @@ -1260,16 +1327,32 @@ new_data += last_index_num * sizeof_type; map_indiceslast_index = last_index_num; - if (0 != _pSLarray_next_index (map_indices, max_dims, num_indices)) + if (0 != next_index (map_indices, max_dims, num_indices, &last_changed_index)) break; } else { - if (-1 == _pSLarray_aget_transfer_elem (at, indices, (VOID_STAR)new_data, sizeof_type, is_ptr)) + if (fast_ok) + { + size_t ofs = indices0; + /* Index ranges have been checked above, no pointers, and a linear range */ + for (i = 1; i < num_indices; i++) + ofs = ofs*at_dimsi + indicesi; + + if (ofs >= at->num_elements) + { + SLang_set_error (SL_Index_Error); + free_array (new_at); + return -1; + } + memcpy ((VOID_STAR)new_data, (char *)at->data + ofs*sizeof_type, sizeof_type); + } + else if (-1 == _pSLarray_aget_transfer_elem (at, indices, (VOID_STAR)new_data, sizeof_type, is_ptr)) { free_array (new_at); return -1; } + new_data += sizeof_type; if (num_indices == 1) @@ -1278,7 +1361,7 @@ if (map_indices0 == max_dims0) break; } - else if (0 != _pSLarray_next_index (map_indices, max_dims, num_indices)) + else if (0 != next_index (map_indices, max_dims, num_indices, &last_changed_index)) break; } } @@ -1382,7 +1465,6 @@ return ret; } -#if SLANG_OPTIMIZE_FOR_SPEED /* This routine assumes that the array is 1d */ int _pSLarray1d_push_elem (SLang_Array_Type *at, SLindex_Type idx) { @@ -1425,14 +1507,13 @@ (*cl->cl_adestroy) (at->data_type, (VOID_STAR)new_data); return ret; } -#endif static int aget_from_array (unsigned int num_indices) { SLang_Array_Type *at; SLang_Object_Type index_objs SLARRAY_MAX_DIMS; - int ret; - int is_index_array, free_indices; + unsigned int i; + int is_index_array, free_indices, ret; /* Implementation note: The push_string_element function calls this with * num_indices==1, and assumes that the pop_array call below will happen. @@ -1470,14 +1551,25 @@ if (is_index_array == 0) { #if SLANG_OPTIMIZE_FOR_SPEED - if ((num_indices == 1) - && (index_objs0.o_data_type == SLANG_ARRAY_INDEX_TYPE) - && (at->num_dims == 1)) + SLindex_Type indicesSLARRAY_MAX_DIMS; + + for (i = 0; i < num_indices; i++) { - ret = _pSLarray1d_push_elem (at, index_objs0.v.index_val); - free_indices = 0; + if (index_objsi.o_data_type != SLANG_ARRAY_INDEX_TYPE) + break; + indicesi = index_objsi.v.index_val; + } + if (i == num_indices) + { + VOID_STAR addr = (*at->index_fun)(at, indices); + + if (addr == NULL) + ret = -1; + else + ret = push_element_at_addr (at, addr, 1); + free_array (at); + return ret; } - else #endif ret = aget_from_indices (at, index_objs, num_indices); } @@ -1487,7 +1579,6 @@ free_array (at); if (free_indices) { - unsigned int i; for (i = 0; i < num_indices; i++) SLang_free_object (index_objs + i); } @@ -1745,11 +1836,7 @@ if (-1 == SLang_pop_array (&at, 0)) return -1; - if ((at->num_elements != num_elements) -#if 0 - || (at->num_dims != 1) -#endif - ) + if (at->num_elements != num_elements) { _pSLang_verror (SL_Index_Error, "Array size is inappropriate for use with index-array"); free_array (at); @@ -1772,7 +1859,7 @@ } static int -aput_from_indices (SLang_Array_Type *at, +aput_from_index_objs (SLang_Array_Type *at, SLang_Object_Type *index_objs, unsigned int num_indices) { SLindex_Type *index_data SLARRAY_MAX_DIMS; @@ -1780,12 +1867,13 @@ SLindex_Type range_delta_buf SLARRAY_MAX_DIMS; SLindex_Type max_dims SLARRAY_MAX_DIMS; SLindex_Type *at_dims; - SLuindex_Type i, num_elements; + SLuindex_Type num_elements; SLang_Array_Type *bt; SLindex_Type map_indicesSLARRAY_MAX_DIMS; SLindex_Type indices SLARRAY_MAX_DIMS; size_t sizeof_type; - int is_ptr, is_array, ret; + unsigned int i, last_changed_index; + int is_ptr, is_array, ret, fast_ok = 0; char *data_to_put; SLuindex_Type data_increment; SLang_Class_Type *cl; @@ -1818,11 +1906,15 @@ if ((range_delta_buflast_index == 1) && (range_buflast_index >= 0)) last_index_num = max_dimslast_index; else - last_index_num = 0; + { + last_index_num = 0; + fast_ok = ((is_ptr == 0) && (at->index_fun == linear_get_data_addr)); + } + last_changed_index = 0; if (num_elements) while (1) { - for (i = 0; i < num_indices; i++) + for (i = last_changed_index; i < num_indices; i++) { SLindex_Type j = map_indicesi; SLindex_Type indx; @@ -1832,14 +1924,7 @@ else indx = index_data ij; - if (indx < 0) - indx += at_dimsi; - - if ((indx < 0) || (indx >= at_dimsi)) - { - do_index_error (i, indx, at_dimsi); - goto return_error; - } + CHECK_INDEX(indx, at_dimsi, goto return_error); indicesi = indx; } @@ -1853,31 +1938,46 @@ data_to_put += last_index_num * data_increment; map_indiceslast_index = last_index_num; - if (0 != _pSLarray_next_index (map_indices, max_dims, num_indices)) + if (0 != next_index (map_indices, max_dims, num_indices, &last_changed_index)) break; } else { - if (-1 == _pSLarray_aput_transfer_elem (at, indices, (VOID_STAR)data_to_put, sizeof_type, is_ptr)) + if (fast_ok) + { + size_t ofs = indices0; + /* Index ranges have been checked above, no pointers, and a linear range */ + for (i = 1; i < num_indices; i++) + ofs = ofs*at_dimsi + indicesi; + + if (ofs >= at->num_elements) + { + SLang_set_error (SL_Index_Error); + goto return_error; + } + memcpy ((char *)at->data + ofs*sizeof_type, (VOID_STAR)data_to_put, sizeof_type); + } + else if (-1 == _pSLarray_aput_transfer_elem (at, indices, (VOID_STAR)data_to_put, sizeof_type, is_ptr)) goto return_error; data_to_put += data_increment; + if (num_indices == 1) { map_indices0++; if (map_indices0 == max_dims0) break; } - else if (0 != _pSLarray_next_index (map_indices, max_dims, num_indices)) + else if (0 != next_index (map_indices, max_dims, num_indices, &last_changed_index)) break; } } ret = 0; - /* drop */ + /* fall through */ - return_error: +return_error: if (bt == NULL) { if (is_ptr) @@ -1889,10 +1989,10 @@ } static int - aput_generic_from_index_array (char *src_data, - SLuindex_Type data_increment, - SLang_Array_Type *ind_at, int is_range, - SLang_Array_Type *dest_at) +aput_generic_from_index_array (char *src_data, + SLuindex_Type data_increment, + SLang_Array_Type *ind_at, int is_range, + SLang_Array_Type *dest_at) { SLindex_Type num_elements = (SLindex_Type) dest_at->num_elements; size_t sizeof_type = dest_at->sizeof_type; @@ -1906,22 +2006,15 @@ SLindex_Type idx = r->first_index, delta = r->delta; SLuindex_Type j, jmax = ind_at->num_elements; + if (-1 == check_range_indices (idx, delta, jmax, num_elements, NULL)) + return -1; + for (j = 0; j < jmax; j++) { size_t offset; SLindex_Type i = idx; - if (i < 0) - { - i += num_elements; - if (i < 0) - i = num_elements; - } - if (i >= num_elements) - { - SLang_set_error (SL_Index_Error); - return -1; - } + if (i < 0) i += num_elements; offset = sizeof_type * (SLuindex_Type)i; if (-1 == transfer_n_elements (dest_at, (VOID_STAR) (dest_data + offset), (VOID_STAR) src_data, sizeof_type, @@ -1943,18 +2036,7 @@ size_t offset; SLindex_Type i = *indices; - if (i < 0) - { - i += num_elements; - if (i < 0) - i = num_elements; - } - if (i >= num_elements) - { - SLang_set_error (SL_Index_Error); - return -1; - } - + CHECK_INDEX(i,num_elements,return -1); offset = sizeof_type * (SLuindex_Type)i; if (-1 == transfer_n_elements (dest_at, (VOID_STAR) (dest_data + offset), @@ -2039,7 +2121,7 @@ case SLANG_LONG_TYPE: case SLANG_ULONG_TYPE: - /* drop */ + /* fall through */ #if LONG_IS_NOT_INT if (-1 == aput_longs_from_index_array (data_to_put, data_increment, ind_at, is_range, @@ -2062,7 +2144,7 @@ } ret = 0; - /* Drop */ + /* fall through */ return_error: @@ -2127,36 +2209,48 @@ if (is_index_array == 0) { #if SLANG_OPTIMIZE_FOR_SPEED - if ((num_indices == 1) && (index_objs0.o_data_type == SLANG_ARRAY_INDEX_TYPE) - && (0 == (at->flags & (SLARR_DATA_VALUE_IS_RANGE|SLARR_DATA_VALUE_IS_POINTER))) - && (1 == at->num_dims) + if ((0 == (at->flags & (SLARR_DATA_VALUE_IS_RANGE|SLARR_DATA_VALUE_IS_POINTER))) && (at->data != NULL)) { - SLindex_Type ofs = index_objs0.v.index_val; - if (ofs < 0) ofs += at->dims0; - if ((ofs >= at->dims0) || (ofs < 0)) - ret = aput_from_indices (at, index_objs, num_indices); - else switch (at->data_type) + SLindex_Type indicesSLARRAY_MAX_DIMS; + unsigned int i; + + for (i = 0; i < num_indices; i++) { - case SLANG_CHAR_TYPE: - ret = SLang_pop_char (((char *)at->data + ofs)); - break; - case SLANG_INT_TYPE: - ret = SLang_pop_integer (((int *)at->data + ofs)); - break; -#if SLANG_HAS_FLOAT - case SLANG_DOUBLE_TYPE: - ret = SLang_pop_double ((double *)at->data + ofs); - break; -#endif - default: - ret = aput_from_indices (at, index_objs, num_indices); + if (index_objsi.o_data_type != SLANG_ARRAY_INDEX_TYPE) + break; + indicesi = index_objsi.v.index_val; } - free_array (at); - return ret; + if (i == num_indices) + { + VOID_STAR addr = (*at->index_fun)(at, indices); + + if (addr == NULL) + ret = -1; + else switch (at->data_type) + { + case SLANG_CHAR_TYPE: + ret = SLang_pop_char ((char *)addr); + break; + case SLANG_INT_TYPE: + ret = SLang_pop_integer ((int *)addr); + break; +# if SLANG_HAS_FLOAT + case SLANG_DOUBLE_TYPE: + ret = SLang_pop_double ((double *)addr); + break; +# endif + default: + ret = aput_from_index_objs (at, index_objs, num_indices); + } + free_array (at); + return ret; + } + + /* drop */ } #endif - ret = aput_from_indices (at, index_objs, num_indices); + ret = aput_from_index_objs (at, index_objs, num_indices); } else ret = aput_from_index_array (at, index_objs0.v.array_val); @@ -2774,7 +2868,7 @@ } strncpy((char *) at->data, s, ndim); - /* drop */ + /* fall through */ free_and_return: free_array (at); @@ -3442,25 +3536,7 @@ dest_data += num_elements * sizeof_type; } -#if 0 - /* If the arrays are all 1-d, and all the same size, then reshape to a - * 2-d array. This will allow us to do, e.g. - * a = 1,2, 3,4 - * to specifiy a 2-d. - * Someday I will generalize this. - */ - /* This is a bad idea. Everyone using it expects concatenation to happen. - * Perhaps I will extend the syntax to allow a 2-d array to be expressed - * as 1,2;3,4. - */ - if ((max_dims == min_dims) && (max_dims == 1) && (min_rows == max_rows)) - { - at->num_dims = 2; - at->dims0 = count; - at->dims1 = min_rows; - } -#endif - free_and_return: +free_and_return: for (i = 0; i < count; i++) free_array (arraysi); @@ -3471,38 +3547,30 @@ int _pSLarray_inline_array (void) { - SLang_Object_Type *obj, *objmin; SLtype type; unsigned int count; SLang_Array_Type *at; - obj = _pSLang_get_run_stack_pointer (); - objmin = _pSLang_get_run_stack_base (); - count = SLang_Num_Function_Args; type = 0; - while ((count > 0) && (--obj >= objmin)) + while (count > 0) { - SLtype this_type = obj->o_data_type; + int this_type; - if (type == 0) - type = this_type; - else if (type != this_type) + count--; + if (-1 == (this_type = SLang_peek_at_stack_n (count))) + return -1; + + if (type == 0) type = (SLtype) this_type; + else if (type != (SLtype) this_type) { - if (-1 == promote_to_common_type (type, this_type, &type)) + if (-1 == promote_to_common_type (type, (SLtype) this_type, &type)) { - _pSLclass_type_mismatch_error (type, this_type); + _pSLclass_type_mismatch_error (type, (SLtype) this_type); return -1; } } - count--; - } - - if (count != 0) - { - SLang_set_error (SL_STACK_UNDERFLOW); - return -1; } count = SLang_Num_Function_Args; @@ -3534,7 +3602,7 @@ { count--; index_obj.v.index_val = count; - if (-1 == aput_from_indices (at, &index_obj, 1)) + if (-1 == aput_from_index_objs (at, &index_obj, 1)) { free_array (at); SLdo_pop_n (count); @@ -3594,7 +3662,7 @@ goto unknown_error; index_obj.v.index_val = i; - if (-1 == aput_from_indices (at, &index_obj, 1)) + if (-1 == aput_from_index_objs (at, &index_obj, 1)) goto return_error; } @@ -3642,7 +3710,7 @@ break; } x = -x; - /* drop */ + /* fall through */ case SLANG_PLUS: first_index = at_r->first_index + x; last_index = at_r->last_index + x; @@ -3703,7 +3771,7 @@ int status = try_range_int_binary (at, op, *(int *)bp, 0, cp); if (status) return status; - /* drop */ + /* fall through */ } if (-1 == coerse_array_to_linear (at)) @@ -3735,7 +3803,7 @@ int status = try_range_int_binary (bt, op, *(int *)ap, 1, cp); if (status) return status; - /* drop */ + /* fall through */ } if (-1 == coerse_array_to_linear (bt)) @@ -4029,7 +4097,7 @@ case SLANG_NULL_TYPE: ret = 1; - /* drop */ + /* fall through */ default: (void) SLdo_pop(); (void) SLang_push_char (ret); @@ -4217,7 +4285,7 @@ (void) SLang_assign_to_ref (ref, SLANG_ARRAY_TYPE, &ct); /* Let any error propagate */ free_array (ct); - /* drop */ + /* fall through */ } else { @@ -4234,7 +4302,7 @@ } (void) SLang_push_array (bt, 0); - /* drop */ + /* fall through */ return_error: free_array (at); @@ -4358,7 +4426,7 @@ if (isdiffi == 0) *idx_ptr++ = i; } (void) SLang_assign_to_ref (ref, SLANG_ARRAY_TYPE, &at); - /* drop */ + /* fall through */ } free_and_return: @@ -4667,6 +4735,7 @@ SLuindex_Type i, nrets, nargs; SLang_Array_Type *at_control; SLang_Name_Type *func; + SLang_Struct_Type *q; SLuindex_Type num_elements; int num_arraymap_parms; @@ -4679,6 +4748,9 @@ return; } + if (-1 == _pSLang_get_qualifiers (&q)) + return; + if (-1 == pop_array_map_args (num_arraymap_parms, &retvals, &nrets, &func, &argvals, &nargs, &at_control)) return; @@ -4730,6 +4802,9 @@ goto return_error; } + if ((q != NULL) && (-1 == _pSLang_set_qualifiers (q))) + goto return_error; + if (-1 == SLexecute_function (func)) goto return_error; @@ -4779,10 +4854,11 @@ (void) SLang_push_array (retvalsi.at, 0); } - /* drop */ + /* fall through */ return_error: free_arraymap_argvals (argvals, nargs); + if (q != NULL) SLang_free_struct (q); SLang_free_function (func); free_arraymap_retvals (retvals, nrets); } @@ -4831,7 +4907,8 @@ free_array (at); } -#if 0 +#define HAVE_AGET_PUT_INTRIN 0 +#if HAVE_AGET_PUT_INTRIN static int pop_int_indices (SLindex_Type *dims, unsigned int ndims) { int i; @@ -4951,7 +5028,7 @@ free_and_return: free_array (at); } -#endif +#endif /* HAVE_AGET_PUT_INTRIN */ static int pop_byte_order (int *bop) { @@ -5031,7 +5108,7 @@ MAKE_INTRINSIC_0("reshape", array_reshape, SLANG_VOID_TYPE), MAKE_INTRINSIC_0("_reshape", _array_reshape, SLANG_VOID_TYPE), MAKE_INTRINSIC_0("_array_byteswap", byteswap_intrin, SLANG_VOID_TYPE), -#if 0 +#if HAVE_AGET_PUT_INTRIN MAKE_INTRINSIC_0("__aget", aget_intrin, SLANG_VOID_TYPE), MAKE_INTRINSIC_0("__aput", aput_intrin, SLANG_VOID_TYPE), #endif @@ -5424,18 +5501,6 @@ SLang_Array_Type *ind_at; SLang_Array_Type *at; -#if 0 - /* The parser generated code for this as if a function call were to be - * made. However, the interpreter simply called the deref object routine - * instead of the function call. So, I must simulate the function call. - * This needs to be formalized to hide this detail from applications - * who wish to do the same. So... - * FIXME: Priority=medium - */ - if (0 == _pSL_increment_frame_pointer ()) - (void) _pSL_decrement_frame_pointer (); -#endif - if (-1 == pop_1d_index_array (&ind_at)) goto return_error;
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slarrfun.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slarrfun.c
Changed
@@ -1,6 +1,6 @@ /* Advanced array manipulation routines for S-Lang */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -795,7 +795,7 @@ (*fun)(a, b, c, a_loops, a_stride, b_loops, b_inc, ai_dims); (void) SLang_push_array (c, 1); - /* drop */ + /* fall through */ free_and_return: SLang_free_array (a); @@ -912,7 +912,8 @@ old_num_dims = 1; } - fcon = (SLarray_Contract_Fun_Type *) c->f; + /* Use double cast to avoid gcc warning */ + fcon = (SLarray_Contract_Fun_Type *) (SLFvoid_Star) c->f; fmap = c->f; if (use_contraction @@ -1537,7 +1538,7 @@ /* Usage: array_swap (a, i, j ,dim); (dim not yet supported) */ static void array_swap (void) { - int i, j; + SLindex_Type i, j; int len; unsigned char *src, *dst; size_t sizeof_type; @@ -1554,15 +1555,16 @@ have_dim = 1; } - if ((-1 == SLang_pop_integer (&j)) - || (-1 == SLang_pop_integer (&i))) + if ((-1 == SLang_pop_array_index (&j)) + || (-1 == SLang_pop_array_index (&i)) + || (-1 == pop_writable_array (&at))) return; if (i == j) - return; /* leave array on stack */ - - if (-1 == pop_writable_array (&at)) - return; + { + SLang_free_array (at); + return; + } if (have_dim) { @@ -1835,7 +1837,7 @@ case 3: if (-1 == SLang_pop_array_index (&istart)) return -1; - /* drop */ + /* fall through */ case 2: if (-1 == SLstack_exch (0, 1)) return -1;
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slarrmis.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slarrmis.c
Changed
@@ -1,6 +1,6 @@ /* Misc Array Functions */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slassoc.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slassoc.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -506,7 +506,7 @@ goto free_and_return; ret = 0; - /* drop */ + /* fall through */ free_and_return: @@ -530,12 +530,12 @@ if (-1 == SLreverse_stack (2)) return -1; has_default_value = 1; - /* drop */ + /* fall through */ case 1: if (0 == SLang_pop_datatype (&type)) break; num_dims--; - /* drop */ + /* fall through */ default: SLdo_pop_n (num_dims); _pSLang_verror (SL_SYNTAX_ERROR, "Usage: Assoc_Type DataType_Type");
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slboseos.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slboseos.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -28,6 +28,8 @@ static SLang_Name_Type *EOS_Callback_Handler = NULL; static SLang_Name_Type *BOF_Callback_Handler = NULL; static SLang_Name_Type *EOF_Callback_Handler = NULL; +static SLang_Name_Type *BOF_Compile_Hook = NULL; +static SLang_Name_Type *BOS_Compile_Hook = NULL; static void set_bos_eos_handlers (SLang_Name_Type *bos, SLang_Name_Type *eos) { @@ -51,6 +53,20 @@ EOF_Callback_Handler = eof; } +static void unset_bof_compile_hook (void) +{ + if (BOF_Compile_Hook != NULL) + SLang_free_function (BOF_Compile_Hook); + BOF_Compile_Hook = NULL; +} + +static void unset_bos_compile_hook (void) +{ + if (BOS_Compile_Hook != NULL) + SLang_free_function (BOS_Compile_Hook); + BOS_Compile_Hook = NULL; +} + static int Handler_Active = 0; int _pSLcall_bos_handler (SLFUTURE_CONST char *file, int line) @@ -113,6 +129,7 @@ return status; } + int _pSLcall_bof_handler (SLFUTURE_CONST char *fun, SLFUTURE_CONST char *file) { int status = 0, err; @@ -169,6 +186,42 @@ return status; } +int _pSLcall_bos_compile_hook (const char *file, long linenum) +{ + if (_pSLang_Error || (NULL == BOS_Compile_Hook)) + return 0; + + if (file == NULL) file = ""; + if ((-1 == SLang_start_arg_list ()) + || (-1 == SLang_push_string ((char *)file)) + || (-1 == SLclass_push_int_obj (SLANG_INT_TYPE, (int) linenum)) + || (-1 == SLang_end_arg_list ()) + || (-1 == SLexecute_function (BOS_Compile_Hook))) + { + unset_bos_compile_hook (); + return -1; + } + return 0; +} + +int _pSLcall_bof_compile_hook (const char *file, const char *func) +{ + if (_pSLang_Error || (NULL == BOF_Compile_Hook)) + return 0; + + if (file == NULL) file = ""; + if ((-1 == SLang_start_arg_list ()) + || (-1 == SLang_push_string ((char *)file)) + || (-1 == SLang_push_string ((char *)func)) + || (-1 == SLang_end_arg_list ()) + || (-1 == SLexecute_function (BOF_Compile_Hook))) + { + unset_bof_compile_hook (); + return -1; + } + return 0; +} + static int pop_new_push_old (SLang_Name_Type **handler) { SLang_Name_Type *new_handler; @@ -214,6 +267,16 @@ (void) pop_new_push_old (&EOF_Callback_Handler); } +static void set_bof_compile_hook (void) +{ + (void) pop_new_push_old (&BOF_Compile_Hook); +} + +static void set_bos_compile_hook (void) +{ + (void) pop_new_push_old (&BOS_Compile_Hook); +} + #if SLANG_HAS_DEBUGGER_SUPPORT static SLang_Name_Type *Debug_Hook = NULL; static int Debug_Handler_Active = 0; @@ -366,6 +429,8 @@ MAKE_INTRINSIC_0("_set_eos_handler", set_eos_handler, SLANG_VOID_TYPE), MAKE_INTRINSIC_0("_set_bof_handler", set_bof_handler, SLANG_VOID_TYPE), MAKE_INTRINSIC_0("_set_eof_handler", set_eof_handler, SLANG_VOID_TYPE), + MAKE_INTRINSIC_0("_set_bof_compile_hook", set_bof_compile_hook, SLANG_VOID_TYPE), + MAKE_INTRINSIC_0("_set_bos_compile_hook", set_bos_compile_hook, SLANG_VOID_TYPE), #if SLANG_HAS_DEBUGGER_SUPPORT MAKE_INTRINSIC_0("_set_frame_variable", set_frame_variable, SLANG_VOID_TYPE), MAKE_INTRINSIC_IS("_get_frame_variable", get_frame_variable, SLANG_VOID_TYPE),
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slbstr.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slbstr.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -899,7 +899,7 @@ (void) SLang_push_bstring (bstr); SLbstring_free (bstr); } - /* drop */ + /* fall through */ free_and_return: for (i = 0; i < nargs; i++)
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slclass.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slclass.c
Changed
@@ -1,6 +1,6 @@ /* User defined objects */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slcmd.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slcmd.c
Changed
@@ -1,6 +1,6 @@ /* cmd line facility for slang */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -252,6 +252,7 @@ /* variable argument number */ case 'v': if (token_present == 0) break; + /* fall through */ case 'V': if (token_present == 0) { @@ -272,6 +273,7 @@ case 's': if (token_present == 0) break; + /* fall through */ case 'S': if (token_present == 0) { @@ -288,6 +290,7 @@ /* integer argument */ case 'i': if (token_present == 0) break; + /* fall through */ case 'I': if ((token_present == 0) || (SLANG_INT_TYPE != guess_type)) { @@ -303,6 +306,7 @@ #if SLANG_HAS_FLOAT case 'f': if (token_present == 0) break; + /* fall through */ case 'F': if ((token_present == 0) || (SLANG_STRING_TYPE == guess_type)) { @@ -316,6 +320,7 @@ /* Generic type */ case 'g': if (token_present == 0) break; + /* fall through */ case 'G': if (token_present == 0) {
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slcmplex.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slcmplex.c
Changed
@@ -1,6 +1,6 @@ /* Complex Data Type definition for S-Lang */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slcommon.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slcommon.c
Changed
@@ -2,7 +2,7 @@ * links to the library. */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slcompat.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slcompat.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slconfig.h -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slconfig.h
Changed
@@ -1,6 +1,6 @@ /* This configuration file is for all non-Unix OS */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -173,6 +173,7 @@ #if defined(__unix__) || (defined(VMS) && (__VMS_VER >= VMS_VERSION_700)) # define HAVE_KILL 1 # define HAVE_CHOWN 1 +# define HAVE_FLOCK 1 #endif #undef HAVE_LSTAT
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slcurses.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slcurses.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slcurses.h -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slcurses.h
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -25,6 +25,10 @@ # include <slang.h> #endif +#ifdef __cplusplus +extern "C" { +#endif + /* This is a temporary hack until lynx is fixed to not include this file. */ #ifndef LYCURSES_H @@ -105,7 +109,7 @@ #define scanw SLcurses_scanw #endif -extern SLcurses_Window_Type *SLcurses_Stdscr; +SL_EXTERN SLcurses_Window_Type *SLcurses_Stdscr; #define WINDOW SLcurses_Window_Type #define stdscr SLcurses_Stdscr @@ -204,7 +208,7 @@ extern int SLcurses_endwin (void); #define endwin SLcurses_endwin -extern int SLcurses_Is_Endwin; +SL_EXTERN int SLcurses_Is_Endwin; #define isendwin() SLcurses_Is_Endwin #define keypad(w,x) ((w)->use_keypad = (x)) @@ -242,7 +246,7 @@ (w)->scroll_max=(w)->nrows, \ wscrl((w), -1)) -extern SLcurses_Char_Type SLcurses_Acs_Map 128; +SL_EXTERN SLcurses_Char_Type SLcurses_Acs_Map 128; #define acs_map SLcurses_Acs_Map #define ACS_ULCORNER (acs_mapSLSMG_ULCORN_CHAR) @@ -300,7 +304,7 @@ #define COLOR_CYAN SLSMG_COLOR_CYAN #define COLOR_WHITE SLSMG_COLOR_LGRAY -extern int SLcurses_Num_Colors; +SL_EXTERN int SLcurses_Num_Colors; #define COLORS SLcurses_Num_Colors #define COLOR_PAIRS (SLcurses_Num_Colors*SLcurses_Num_Colors) @@ -338,7 +342,7 @@ extern int SLcurses_winsch (SLcurses_Window_Type *, int); #define winsch SLcurses_winsch -extern int SLcurses_Esc_Delay;/* ESC expire time in milliseconds (ncurses compatible) */ +SL_EXTERN int SLcurses_Esc_Delay;/* ESC expire time in milliseconds (ncurses compatible) */ #define ESCDELAY SLcurses_Esc_Delay extern int SLcurses_clearok (SLcurses_Window_Type *, int); @@ -366,7 +370,9 @@ /* These have no place in C */ #define TRUE 1 #define FALSE 0 -#define bool int +#if !defined(_STDBOOL) /* MSVC v18+ */ +# define bool int +#endif /* Lynx compatability */ #else @@ -387,3 +393,7 @@ #define endwin SLsmg_reset_smg(),SLang_reset_tty #endif + +#ifdef __cplusplus +} +#endif
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/sldisply.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/sldisply.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -98,8 +98,8 @@ * * The bits are split so we can maintain ABI compatibility on 64 bit machines. */ -#if SLTT_HAS_TRUECOLOR_SUPPORT && (SIZEOF_LONG == 8) static int Has_True_Color = 0; +#if SLTT_HAS_TRUECOLOR_SUPPORT && (SIZEOF_LONG == 8) # if 0 # define FG_MASK_LOW 0x0000000000FFFFFFULL # define FG_MASK_HIGH 0x0200000000000000ULL @@ -153,8 +153,11 @@ # define MAKE_COLOR(fg, bg) (((fg)<<8) | ((bg)<<16)) #endif -int SLtt_Screen_Cols = 80; -int SLtt_Screen_Rows = 24; +#define DEFAULT_SCREEN_COLS (80) +#define DEFAULT_SCREEN_ROWS (24) + +int SLtt_Screen_Cols = DEFAULT_SCREEN_COLS; +int SLtt_Screen_Rows = DEFAULT_SCREEN_ROWS; int SLtt_Term_Cannot_Insert = 0; int SLtt_Term_Cannot_Scroll = 0; int SLtt_Use_Ansi_Colors = 0; @@ -308,14 +311,70 @@ static int Cursor_Set; /* 1 if cursor position known, 0 * if not. -1 if only row is known */ -/* This is used only in relative-cursor-addressing mode */ -static SLsmg_Char_Type Display_Start_CharsSLTT_MAX_SCREEN_ROWS; - #define MAX_OUTPUT_BUFFER_SIZE 4096 - static unsigned char Output_BufferMAX_OUTPUT_BUFFER_SIZE; static unsigned char *Output_Bufferp = Output_Buffer; +/* This is used only in relative-cursor-addressing mode */ +static SLsmg_Char_Type Display_Start_Chars_BufDEFAULT_SCREEN_ROWS; +static SLsmg_Char_Type *Display_Start_Chars = Display_Start_Chars_Buf; +static unsigned int Display_Start_Chars_Nrows = DEFAULT_SCREEN_ROWS; + +static SLsmg_Char_Type Smart_Puts_Static_BufferDEFAULT_SCREEN_COLS+1; +static SLsmg_Char_Type *Smart_Puts_Buffer = Smart_Puts_Static_Buffer; +static unsigned int Smart_Puts_Buffer_Ncols = DEFAULT_SCREEN_COLS; + +/* Reallocate buffers for large screens and update SLtt_Screen_Rows/Cols vars */ +static int resize_screen_buffers (unsigned int r, unsigned int c) +{ + int status; + + if (c <= Smart_Puts_Buffer_Ncols) + SLtt_Screen_Cols = c; + else + { + SLsmg_Char_Type *s; + + s = (SLsmg_Char_Type *)SLmalloc(sizeof(SLsmg_Char_Type)*(c+1)); + if (s != NULL) + { + if (Smart_Puts_Buffer != Smart_Puts_Static_Buffer) + SLfree ((char *)Smart_Puts_Buffer); + Smart_Puts_Buffer = s; + Smart_Puts_Buffer_Ncols = c; + SLtt_Screen_Cols = c; + } + else + { + /* No update -- keep screen size */ + status = -1; + } + } + + if (r <= Display_Start_Chars_Nrows) + SLtt_Screen_Rows = r; + else + { + SLsmg_Char_Type *s; + + s = (SLsmg_Char_Type *)SLcalloc(r,sizeof(SLsmg_Char_Type)); + if (s != NULL) + { + if (Display_Start_Chars != Display_Start_Chars_Buf) + SLfree ((char *)Display_Start_Chars); + Display_Start_Chars = s; + Display_Start_Chars_Nrows = r; + SLtt_Screen_Rows = r; + } + else + { + /* No update -- keep screen size */ + status = -1; + } + } + return status; +} + unsigned long SLtt_Num_Chars_Output = 0; int _pSLusleep (unsigned long usecs) @@ -456,7 +515,8 @@ int zero_pad; int field_width; int variables 26; - int stack 64; +#define STACK_SIZE 64 + int stack STACK_SIZE; unsigned int stack_len; int parms 10; #define STACK_POP (stack_len ? stack--stack_len : 0) @@ -483,7 +543,7 @@ fmt_max = fmt + strlen (fmt); - while ((fmt < fmt_max) && (b < bmax)) + while ((fmt < fmt_max) && (b < bmax) && (stack_len < STACK_SIZE)) { unsigned char ch = *fmt++; @@ -534,7 +594,7 @@ break; zero_pad = 1; fmt++; - /* drop */ + /* fall through */ case '2': case '3': @@ -560,7 +620,7 @@ } field_width = (ch - '0'); - /* drop */ + /* fall through */ case 'd': z = STACK_POP; @@ -711,7 +771,7 @@ /* z == 0 and test has failed. So, skip past this entire if * expression to the matching else or matching endif. */ - /* drop */ + /* fall through */ case 'e': /* else */ parse_level = 0; @@ -1092,13 +1152,13 @@ SLtt_flush_output (); } -static void write_string_with_care (SLCONST char *); +static void write_string_with_care (SLCONST char *, unsigned int); static void del_eol (void) { if ((Cursor_c == 0) && (Use_Relative_Cursor_Addressing) - && (Cursor_r < SLTT_MAX_SCREEN_ROWS)) + && (Cursor_r < SLtt_Screen_Rows)) { Display_Start_CharsCursor_r.nchars = 0; } @@ -1112,7 +1172,7 @@ while (Cursor_c < SLtt_Screen_Cols) { - write_string_with_care (" "); + write_string_with_care (" ", 1); Cursor_c++; } Cursor_c = SLtt_Screen_Cols - 1; @@ -1792,13 +1852,10 @@ /* The whole point of this routine is to prevent writing to the last column * and last row on terminals with automatic margins. */ -static void write_string_with_care (SLCONST char *str) +static void write_string_with_care (SLCONST char *str, unsigned int len) { - SLstrlen_Type len; - - if (str == NULL) return; + if ((str == NULL) || (len == 0)) return; - len = strlen (str); if (Automatic_Margins && (Cursor_r + 1 == SLtt_Screen_Rows)) { if (_pSLtt_UTF8_Mode == 0) @@ -1816,38 +1873,55 @@ } else { - SLstrlen_Type nchars = SLutf8_strlen((SLuchar_Type *)str, 1); + SLstrlen_Type nchars; + + (void) SLutf8_skip_chars ((SLuchar_Type *)str, (SLuchar_Type *)str + len, len, &nchars, 1); if (nchars + (unsigned int) Cursor_c >= (unsigned int) SLtt_Screen_Cols) - { - if (SLtt_Screen_Cols > Cursor_c) - { - char *p; - nchars = (SLstrlen_Type)(SLtt_Screen_Cols - Cursor_c - 1); - p = (char *)SLutf8_skip_chars((SLuchar_Type *) str, (SLuchar_Type *)(str + len), nchars, NULL, 1); - len = p - str; - } - else - len = 0; - } + { + if (SLtt_Screen_Cols > Cursor_c) + { + char *p; + nchars = (SLstrlen_Type)(SLtt_Screen_Cols - Cursor_c - 1); + p = (char *)SLutf8_skip_chars((SLuchar_Type *) str, (SLuchar_Type *)(str + len), nchars, NULL, 1); + len = p - str; + } + else + len = 0; + } } } tt_write (str, len); } +_INLINE_ static unsigned char * +buffer_or_write_char (unsigned char *pmin, + unsigned char *p, + unsigned char *pmax, + unsigned char ch) +{ + if (p == pmax) + { + write_string_with_care ((char *)pmin, p - pmin); + p = pmin; + } + *p++ = ch; + return p; +} + static void send_attr_str (SLsmg_Char_Type *s, SLsmg_Char_Type *smax) { - unsigned char out1+SLUTF8_MAX_MBLEN*SLSMG_MAX_CHARS_PER_CELL*SLTT_MAX_SCREEN_COLS; + unsigned char outSLUTF8_MAX_MBLEN*SLSMG_MAX_CHARS_PER_CELL; unsigned char *p, *pmax; - register SLtt_Char_Type attr; + SLtt_Char_Type attr; SLsmg_Color_Type color, last_color = (SLsmg_Color_Type)-1; int dcursor_c; p = out; - pmax = p + (sizeof (out)-1); + pmax = p + sizeof (out); if ((Cursor_c == 0) && (Use_Relative_Cursor_Addressing) - && (Cursor_r < SLTT_MAX_SCREEN_ROWS)) + && (Cursor_r < SLtt_Screen_Rows)) { if (s < smax) Display_Start_CharsCursor_r = *s; @@ -1866,7 +1940,7 @@ /* 2nd element of a char that occupies two columns */ s++; if (_pSLtt_UTF8_Mode == 0) - *p++ = ' '; + p = buffer_or_write_char (out, p, pmax, ' '); dcursor_c++; continue; } @@ -1906,8 +1980,7 @@ { if (p != out) { - *p = 0; - write_string_with_care ((char *) out); + write_string_with_care ((char *) out, p-out); p = out; Cursor_c += dcursor_c; dcursor_c = 0; @@ -1919,32 +1992,37 @@ } if ((wch < 0x80) && (nchars == 1)) - *p++ = (unsigned char) wch; + p = buffer_or_write_char(out, p, pmax, (unsigned char) wch); else if (_pSLtt_UTF8_Mode == 0) { if (wch > 255) wch = '?'; else if (wch < (SLwchar_Type)SLsmg_Display_Eight_Bit) wch = '?'; - *p++ = (unsigned char) wch; + p = buffer_or_write_char(out, p, pmax, (unsigned char) wch); } else { unsigned int i; + unsigned char bufSLUTF8_MAX_MBLEN; for (i = 0; i < nchars; i++) { - if (NULL == (p = SLutf8_encode (s->wcharsi, p, pmax-p))) + unsigned char *b, *b1; + b1 = SLutf8_encode (s->wcharsi, buf, sizeof(buf)); + if (b1 == NULL) { fprintf (stderr, "*** send_attr_str: buffer too small\n"); - return; + continue; } + b = buf; + while (b < b1) + p = buffer_or_write_char (out, p, pmax, *b++); } } dcursor_c++; s++; } - *p = 0; - if (p != out) write_string_with_care ((char *) out); + if (p != out) write_string_with_care ((char *) out, p-out); Cursor_c += dcursor_c; } @@ -1972,8 +2050,7 @@ n = sizeof (buf) - 1; #endif SLMEMSET (buf, ' ', n); - bufn = 0; - write_string_with_care (buf); + write_string_with_care (buf, n); Cursor_c += n; } else if (Curs_RightN_Str != NULL) @@ -2016,7 +2093,7 @@ void SLtt_smart_puts(SLsmg_Char_Type *neww, SLsmg_Char_Type *oldd, int len, int row) { register SLsmg_Char_Type *p, *q, *qmax, *pmax, *buf; - SLsmg_Char_Type bufferSLTT_MAX_SCREEN_COLS+1; + SLsmg_Char_Type *buffer = Smart_Puts_Buffer; SLsmg_Char_Type *space_match, *last_buffered_match; #ifdef HP_GLITCH_CODE int handle_hp_glitch = 0; @@ -2053,8 +2130,8 @@ space_char->nchars = 1; space_char->wchars0 = ' '; - if (len > SLTT_MAX_SCREEN_COLS) - len = SLTT_MAX_SCREEN_COLS; + if (len > SLtt_Screen_Cols) + len = SLtt_Screen_Cols; q = oldd; p = neww; qmax = oldd + len; @@ -2445,7 +2522,7 @@ */ Cursor_c = 0; Cursor_r++; - if (Cursor_r < SLTT_MAX_SCREEN_ROWS) + if (Cursor_r < SLtt_Screen_Rows) { SLsmg_Char_Type *c = Display_Start_Chars + Cursor_r; if (c->nchars) @@ -2657,9 +2734,9 @@ char *SLtt_tgoto (char *cap, int col, int row) { - static char buf64; + static char buf128; /* beware of overflows. 2^64 is 20 bytes printed */ - if (strlen(cap) > 23) + if (strlen(cap) > 80) strcpy(buf, "capability too long"); else tt_sprintf(buf, sizeof(buf), cap, row, col); @@ -2972,6 +3049,12 @@ if ((Max_Terminfo_Colors = tt_tgetnum ("Co")) < 0) Max_Terminfo_Colors = 8; + if (TGETFLAG("RGB")) + { + Max_Terminfo_Colors = 0x1000000; + Has_True_Color = 1; + } + if ((Color_Bg_Str != NULL) && (Color_Fg_Str != NULL)) SLtt_Use_Ansi_Colors = 1; else @@ -3307,10 +3390,10 @@ if (s != NULL) c = atoi (s); } - if ((r <= 0) || (r > SLTT_MAX_SCREEN_ROWS)) r = 24; - if ((c <= 0) || (c > SLTT_MAX_SCREEN_COLS)) c = 80; - SLtt_Screen_Rows = r; - SLtt_Screen_Cols = c; + if (r <= 0) r = 24; + if (c <= 0) c = 80; + + (void) resize_screen_buffers (r, c); } #if SLTT_HAS_NON_BCE_SUPPORT
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/sldostty.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/sldostty.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -495,7 +495,7 @@ break; /* ^space = ^@ */ scan = 3; /* send back Ctrl-@ => ^@^C */ - /* drop */ + /* fall through */ case 0xe0: case 0: /* extended key code */ ch = _pSLpc_convert_scancode (scan, 0, 1);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slerr.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slerr.c
Changed
@@ -1,6 +1,6 @@ /* error handling common to all routines. */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slerrno.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slerrno.c
Changed
@@ -2,7 +2,7 @@ * way so that they may be used in slang scripts. */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -82,6 +82,10 @@ # define EAGAIN -1 #endif {"Try again", EAGAIN, "EAGAIN"}, +#ifndef EWOULDBLOCK +# define EWOULDBLOCK -1 +#endif + {"Operation would block", EWOULDBLOCK, "EWOULDBLOCK"}, #ifndef ENOMEM # define ENOMEM -1 #endif @@ -566,7 +570,7 @@ if (e != NULL) /* already initialized */ return 0; - if ((-1 == SLadd_intrinsic_function ("errno_string", (FVOID_STAR) intrin_errno_string, + if ((-1 == SLadd_intrinsic_function ("errno_string", (FVOID_STAR)(SLFvoid_Star)intrin_errno_string, SLANG_STRING_TYPE, 0)) || (-1 == SLadd_intrinsic_variable ("errno", (VOID_STAR)&_pSLerrno_errno, SLANG_INT_TYPE, 1))) return -1;
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slexcept.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slexcept.c
Changed
@@ -1,6 +1,6 @@ /* Exception Handling */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -315,15 +315,15 @@ if (-1 == SLang_pop (&Object_Thrown)) return -1; Object_Thrownp = &Object_Thrown; - /* drop */ + /* fall through */ case 2: if (-1 == SLang_pop_slstring (&msg)) { free_thrown_object (); return -1; } + /* fall through */ case 1: - /* drop */ if (-1 == _pSLerr_pop_exception (&e)) { SLang_free_slstring (msg);/* NULL ok */
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slfile.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slfile.c
Changed
@@ -1,6 +1,6 @@ /* file stdio intrinsics for S-Lang */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slfpu.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slfpu.c
Changed
@@ -1,6 +1,6 @@ /* Floating point exceptions */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slgetkey.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slgetkey.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -45,8 +45,8 @@ SLang_Input_Buffer_Len--; imax = SLang_Input_Buffer_Len; - SLMEMCPY ((char *) SLang_Input_Buffer, - (char *) (SLang_Input_Buffer + 1), imax); + memmove ((char *) SLang_Input_Buffer, + (char *) (SLang_Input_Buffer + 1), imax); } else if (SLANG_GETKEY_ERROR == (ch = _pSLsys_getkey ())) return ch; @@ -86,11 +86,9 @@ int SLang_buffer_keystring (unsigned char *s, unsigned int n) { - if (n + SLang_Input_Buffer_Len + 3 > SL_MAX_INPUT_BUFFER_LEN) return -1; - SLMEMCPY ((char *) SLang_Input_Buffer + SLang_Input_Buffer_Len, - (char *) s, n); + memcpy ((char *) SLang_Input_Buffer + SLang_Input_Buffer_Len, (char *) s, n); SLang_Input_Buffer_Len += n; return 0; }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slimport.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slimport.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slintall.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slintall.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slischar.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slischar.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slistruc.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slistruc.c
Changed
@@ -1,6 +1,6 @@ /* Intrinsic Structure type implementation */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slkeymap.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slkeymap.c
Changed
@@ -4,7 +4,7 @@ * structures. Also included are routines for managing the keymaps. */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slkeypad.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slkeypad.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/sllimits.h -> _service:tar_scm:slang-2.3.3.tar.bz2/src/sllimits.h
Changed
@@ -1,6 +1,6 @@ /* sllimits.h */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -25,11 +25,16 @@ /* slstring.c: Size of the hash table used for strings (prime numbers) */ #define SLSTRING_HASH_TABLE_SIZE 140009 /* was 32327, 25013, 10007 */ /* Other large primes: 70001, 100003, 300007,... */ -/* slang.c: maximum size of run time stack */ +/* slang.c: The stack size grows dynamically from SLANG_INITIAL_STACK_LEN + * in increments of SLANG_INITIAL_STACK_LEN up to a maximum size of + * SLANG_MAX_STACK_LEN. + */ #ifdef __MSDOS_16BIT__ -# define SLANG_MAX_STACK_LEN 500 +# define SLANG_INITIAL_STACK_LEN 512 +# define SLANG_MAX_STACK_LEN 1024 #else -# define SLANG_MAX_STACK_LEN 2500 +# define SLANG_INITIAL_STACK_LEN (2*1024) +# define SLANG_MAX_STACK_LEN (1024*1024) #endif /* slang.c: This sets the size on the depth of function calls. @@ -93,12 +98,8 @@ #define SLANG_INNERPROD_BLOCK_SIZE 29 #if !defined(__MSDOS_16BIT__) -# define SLTT_MAX_SCREEN_COLS 512 -# define SLTT_MAX_SCREEN_ROWS 512 # define SLTT_MAX_COLORS 0x8000 /* consistent with SLSMG_COLOR_MASK */ #else -# define SLTT_MAX_SCREEN_ROWS 64 -# define SLTT_MAX_SCREEN_COLS 75 /* #define SLTT_MAX_COLORS 0x8000 */ /* use slvideo.c default */ #endif
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/sllist.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/sllist.c
Changed
@@ -1,6 +1,6 @@ /* List of objects */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -494,7 +494,7 @@ c1->num_elements = num; c->num_elements -= num; c->elementsc->num_elements = *obj; - /* drop */ + /* fall through */ the_return: @@ -1233,7 +1233,7 @@ } ret = 0; - /* drop */ + /* fall through */ free_and_return: SLang_free_object (&obj);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/sllower.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/sllower.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slmalloc.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slmalloc.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slmath.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slmath.c
Changed
@@ -1,6 +1,6 @@ /* sin, cos, etc, for S-Lang */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -1278,7 +1278,7 @@ case 3: if (-1 == SLang_pop_int (&use_factorial)) return; - /* drop */ + /* fall through */ case 2: break; @@ -1390,7 +1390,7 @@ } (void) SLang_push_array (y_at, 1); - /* drop */ + /* fall through */ free_and_return: free_array_or_scalar (&ast); SLang_free_array (coeff_at); @@ -1991,10 +1991,10 @@ for (i = 0; i < imax; i++) ci = LDEXP_FUN(ai, e_ptri); } - /* drop */ + /* fall through */ push_free_and_return: (void) SLang_push_array (c_at, 0); - /* drop */ + /* fall through */ free_and_return: if (e_at != NULL) SLang_free_array (e_at); SLang_free_array (c_at); @@ -2083,7 +2083,7 @@ if (0 == SLang_push_array (s_at, 0)) (void) SLang_push_array (c_at, 0); - /* drop */ + /* fall through */ free_and_return: if (c_at != NULL) SLang_free_array (c_at); if (s_at != NULL) SLang_free_array (s_at);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slmemchr.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slmemchr.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slmemcmp.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slmemcmp.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slmemcpy.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slmemcpy.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slmemset.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slmemset.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slmisc.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slmisc.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -145,7 +145,7 @@ case 'u': isunicode = 1; - /* drop */ + /* fall through */ case 'x': /* hex */ base = 16; max = '9'; @@ -644,7 +644,7 @@ _pSLang_verror (SL_SYNTAX_ERROR, "8 or 9 are not permitted in binary or octal numbers"); return -1; } - /* drop */ + /* fall through */ case '7': case '6': case '5': @@ -656,6 +656,7 @@ _pSLang_verror (SL_SYNTAX_ERROR, "Only digits 0 and 1 are permitted in binary numbers"); return -1; } + /* fall through */ case '1': case '0': ch1 -= '0'; @@ -756,7 +757,7 @@ _pSLang_verror (SL_SYNTAX_ERROR, "8 or 9 are not permitted in binary or octal numbers"); return -1; } - /* drop */ + /* fall through */ case '7': case '6': case '5': @@ -768,6 +769,7 @@ _pSLang_verror (SL_SYNTAX_ERROR, "Only digits 0 and 1 are permitted in binary numbers"); return -1; } + /* fall through */ case '1': case '0': ch1 -= '0';
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slnspace.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slnspace.c
Changed
@@ -1,7 +1,7 @@ /* -*- mode: C; mode: fold; -*- */ /* slnspace.c --- Name Space implementation */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slos2tty.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slos2tty.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slospath.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slospath.c
Changed
@@ -1,6 +1,6 @@ /* Pathname intrinsic functions */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slpack.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slpack.c
Changed
@@ -1,6 +1,6 @@ /* Pack objects as a binary string */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -320,6 +320,7 @@ case 'S': case 'A': ft->pad = ' '; + /* fall through */ case 'a': case 's': case 'z': @@ -857,7 +858,7 @@ at->num_refs++; bt = at; } - else/* drop */ + else/* fall through */ #endif if (NULL == (bt = SLang_duplicate_array (at))) return NULL;
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slparse.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slparse.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -3130,7 +3130,7 @@ _pSLparse_error (SL_SYNTAX_ERROR, "Expecting ')'", ctok, 0); break; } - /* drop */ + /* fall through */ default: simple_expression (ctok);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slpath.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slpath.c
Changed
@@ -1,6 +1,6 @@ /* Pathname and filename functions */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slposdir.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slposdir.c
Changed
@@ -1,6 +1,6 @@ /* file intrinsics for S-Lang */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -184,84 +184,176 @@ return SLang_push_cstruct ((VOID_STAR) &s, Stat_Struct); } -static void stat_cmd (char *file) +typedef struct { - struct stat st; - int status; - int opt_attrs; -#if defined(__MSDOS__) || defined(__WIN32__) - unsigned int len = strlen (file); - int is_malloced = 0; + int type; + int fd; + char *path; + SLFile_FD_Type *f; + SLang_MMT_Type *mmt; + FILE *fp; +} +Stat_Arg_Type; - if (len && ((filelen-1 == '\\') || (filelen-1 == '/'))) + +static void free_stat_arg (Stat_Arg_Type *sa) +{ + switch (sa->type) { - file = SLmake_nstring (file, len-1); - if (file == NULL) - return; + default: + case SLANG_INT_TYPE: + break; + + case SLANG_FILE_FD_TYPE: + if (sa->f != NULL) SLfile_free_fd (sa->f); + break; - is_malloced = 1; + case SLANG_FILE_PTR_TYPE: + if (sa->mmt != NULL) SLang_free_mmt (sa->mmt); + break; + + case SLANG_STRING_TYPE: + SLang_free_slstring (sa->path); + break; } -#endif +} - while ((-1 == (status = stat (file, &st))) - && (is_interrupt (errno))) - continue; +static int pop_stat_arg (Stat_Arg_Type *sa) +{ + int status; - if (status == 0) - { -#ifdef __WIN32__ - opt_attrs = GetFileAttributes (file); -#else - opt_attrs = 0; -#endif + memset (sa, 0, sizeof(Stat_Arg_Type)); - push_stat_struct (&st, opt_attrs); - } - else + sa->type = SLang_peek_at_stack (); + switch (sa->type) { - _pSLerrno_errno = errno; - SLang_push_null (); - } + default: + case SLANG_INT_TYPE: + status = SLang_pop_int (&sa->fd); + break; + case SLANG_FILE_FD_TYPE: + if (0 == (status = SLfile_pop_fd (&sa->f))) + status = SLfile_get_fd (sa->f, &sa->fd); + break; + + case SLANG_FILE_PTR_TYPE: + if (0 == (status = SLang_pop_fileptr (&sa->mmt, &sa->fp))) + sa->fd = fileno (sa->fp); + break; + + case SLANG_STRING_TYPE: + case SLANG_BSTRING_TYPE: + sa->type = SLANG_STRING_TYPE; + if (0 == (status = SLang_pop_slstring (&sa->path))) + { #if defined(__MSDOS__) || defined(__WIN32__) - if (is_malloced) - SLfree (file); + char *file = sa->path; + unsigned int len = strlen (file); + + if (len && ((filelen-1 == '\\') || (filelen-1 == '/'))) + { + file = SLmake_nstring (file, len-1); + if (file == NULL) + status = -1; + else + { + SLang_free_slstring (sa->path); + sa->path = file; + } + } +#endif + } + break; + } + + if (status == -1) + { + free_stat_arg (sa); +#ifdef EINVAL + (void) SLerrno_set_errno (EINVAL); #endif + } + return status; } -static void lstat_cmd (char *file) +static int do_xstat (int x) { -#ifdef HAVE_LSTAT + Stat_Arg_Type sa; struct stat st; - int opt_attrs; + int status = 0; + int opt_attrs = 0; + + if (-1 == pop_stat_arg (&sa)) + return -1; - while (-1 == lstat (file, &st)) + switch (x) { - if (is_interrupt (errno)) - continue; + case 'l': + if (sa.type == SLANG_STRING_TYPE) + { +#ifdef HAVE_LSTAT + while ((-1 == (status = lstat (sa.path, &st))) + && (is_interrupt (errno))) + ; + break; +#endif + } + /* fall through */ + default: + case 's': + if (sa.type == SLANG_STRING_TYPE) + { + while ((-1 == (status = stat (sa.path, &st))) + && (is_interrupt (errno))) + ; +#ifdef __WIN32__ + if (status == 0) opt_attrs = GetFileAttributes (sa.path); +#endif + } + else + { + while ((-1 == (status = fstat (sa.fd, &st))) + && (is_interrupt (errno))) + ; +#ifdef __WIN32__ + if (status == 0) + { + /* GetFileAttributes for fd??? */ + } +#endif + } + break; + } + if (status == 0) + { + status = push_stat_struct (&st, opt_attrs); + } + else + { _pSLerrno_errno = errno; - SLang_push_null (); - return; + (void) SLang_push_null (); } -# ifdef __WIN32__ - opt_attrs = GetFileAttributes (file); -# else - opt_attrs = 0; -# endif + free_stat_arg (&sa); + return status; +} - push_stat_struct (&st, opt_attrs); -#else - stat_cmd (file); -#endif /* HAVE_LSTAT */ +static void stat_cmd (void) +{ + (void) do_xstat ('s'); +} + +static void lstat_cmd (void) +{ + do_xstat ('l'); } #if defined(HAVE_STATVFS) static SLang_CStruct_Field_Type StatVFS_Struct = { MAKE_CSTRUCT_UINT_FIELD(struct statvfs, f_bsize, "f_bsize", 0), - MAKE_CSTRUCT_UINT_FIELD(struct statvfs, f_bsize, "f_bsize", 0), MAKE_CSTRUCT_UINT_FIELD(struct statvfs, f_frsize, "f_frsize", 0), MAKE_CSTRUCT_UINT_FIELD(struct statvfs, f_blocks, "f_blocks", 0), MAKE_CSTRUCT_UINT_FIELD(struct statvfs, f_bfree, "f_bfree", 0), @@ -278,48 +370,21 @@ static void statvfs_cmd (void) { struct statvfs vfs; - FILE *fp; - char *path = NULL; - SLFile_FD_Type *f = NULL; - SLang_MMT_Type *mmt = NULL; - int fd, status; - - switch (SLang_peek_at_stack ()) - { - default: - case SLANG_INT_TYPE: - if (-1 == SLang_pop_int (&fd)) - return; - break; - - case SLANG_FILE_FD_TYPE: - if (-1 == SLfile_pop_fd (&f)) - return; - if (-1 == SLfile_get_fd (f, &fd)) - goto free_and_return; - break; - - case SLANG_FILE_PTR_TYPE: - if (-1 == SLang_pop_fileptr (&mmt, &fp)) - return; - fd = fileno (fp); - break; + Stat_Arg_Type st; + int status; - case SLANG_STRING_TYPE: - if (-1 == SLang_pop_slstring (&path)) - return; - break; - } + if (-1 == pop_stat_arg (&st)) + return; - if (path != NULL) + if (st.type == SLANG_STRING_TYPE) { - while ((-1 == (status = statvfs (path, &vfs))) + while ((-1 == (status = statvfs (st.path, &vfs))) && (is_interrupt (errno))) continue; } else { - while ((-1 == (status = fstatvfs (fd, &vfs))) + while ((-1 == (status = fstatvfs (st.fd, &vfs))) && (is_interrupt (errno))) continue; } @@ -332,11 +397,8 @@ (void) SLang_push_null (); } - /* drop */ -free_and_return: - if (f != NULL) SLfile_free_fd (f); - if (mmt != NULL) SLang_free_mmt (mmt); - if (path != NULL) SLang_free_slstring (path); + /* fall through */ + free_stat_arg (&st); } #endif /* HAVE_STATVFS */ @@ -661,7 +723,7 @@ *dot = ''; s = str + (len - 1); - /* Drop */ + /* fall through */ add_dir_version: strcpy (s, ".dir"); @@ -1129,6 +1191,7 @@ case 2: if (-1 == SLang_pop_slstring (&sopt)) return; + /* fall through */ case 1: if (-1 == SLang_pop_slstring (&s)) { @@ -1190,8 +1253,8 @@ #ifdef HAVE_LINK MAKE_INTRINSIC_SS("hardlink", hardlink_cmd, SLANG_INT_TYPE), #endif - MAKE_INTRINSIC_S("lstat_file", lstat_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_S("stat_file", stat_cmd, SLANG_VOID_TYPE), + MAKE_INTRINSIC_0("lstat_file", lstat_cmd, SLANG_VOID_TYPE), + MAKE_INTRINSIC_0("stat_file", stat_cmd, SLANG_VOID_TYPE), MAKE_INTRINSIC_SI("stat_is", stat_is_cmd, SLANG_CHAR_TYPE), #ifdef HAVE_MKFIFO MAKE_INTRINSIC_SI("mkfifo", mkfifo_cmd, SLANG_INT_TYPE),
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slposio.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slposio.c
Changed
@@ -1,7 +1,7 @@ /* This module implements an interface to posix system calls */ /* file stdio intrinsics for S-Lang */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -999,6 +999,26 @@ return status; } +#ifdef HAVE_FLOCK +static int flock_cmd (int *op) +{ + SLFile_FD_Type *f; + SLang_MMT_Type *mmt; + int fd, status; + + if (-1 == pop_fd (&fd, &f, &mmt)) + return 0; /* invalid descriptor */ + + while ((-1 == (status = flock (fd, *op))) + && is_interrupt (errno, 0)) + ; + + if (mmt != NULL) SLang_free_mmt (mmt); + if (f != NULL) SLfile_free_fd (f); + return status; +} +#endif + #define I SLANG_INT_TYPE #define V SLANG_VOID_TYPE #define F SLANG_FILE_FD_TYPE @@ -1024,6 +1044,9 @@ #if defined(TTYNAME_R) MAKE_INTRINSIC_0("ttyname", posix_ttyname, V), #endif +#ifdef HAVE_FLOCK + MAKE_INTRINSIC_1("flock", flock_cmd, I, I), +#endif SLANG_END_INTRIN_FUN_TABLE }; #undef I @@ -1075,6 +1098,19 @@ #ifdef O_LARGEFILE MAKE_ICONSTANT("O_LARGEFILE", O_LARGEFILE), #endif +#ifdef LOCK_SH + MAKE_ICONSTANT("LOCK_SH", LOCK_SH), +#endif +#ifdef LOCK_NB + MAKE_ICONSTANT("LOCK_NB", LOCK_NB), +#endif +#ifdef LOCK_EX + MAKE_ICONSTANT("LOCK_EX", LOCK_EX), +#endif +#ifdef LOCK_UN + MAKE_ICONSTANT("LOCK_UN", LOCK_UN), +#endif + SLANG_END_ICONST_TABLE };
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slprepr.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slprepr.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slproc.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slproc.c
Changed
@@ -1,6 +1,6 @@ /* Process specific system calls */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slregexp.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slregexp.c
Changed
@@ -1,6 +1,6 @@ /* ed style regular expressions */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -50,24 +50,25 @@ #define SET_BIT(b, n) b(unsigned int) (n) >> 3 |= 1 << ((unsigned int) (n) % 8) #define TEST_BIT(b, n) (b(unsigned int)(n) >> 3 & (1 << ((unsigned int) (n) % 8))) -#define LITERAL 1 -#define RANGE 2 /* ... */ -#define ANY 3 /* . */ -#define BOL 4 /* ^ */ -#define EOL 5 /* $ */ -#define NTH_MATCH 6 /* \1 \2 ... \9 */ -#define OPAREN 7 /* \( */ -#define CPAREN 0x8 /* \) */ -#define ANY_DIGIT 0x9 /* \d */ -#define BOW 0xA /* \< */ -#define EOW 0xB /* \> */ -#if 0 -#define NOT_LITERAL 0xC /* \~ */ -#endif -#define STAR 0x80 /* * */ -#define LEAST_ONCE 0x40 /* + */ -#define MAYBE_ONCE 0x20 /* ? */ -#define MANY 0x10 /* {n,m} */ +#define LITERAL 0x01 +#define RANGE 0x02 /* ... */ +#define ANY 0x03 /* . */ +#define BOL 0x04 /* ^ */ +#define EOL 0x05 /* $ */ +#define NTH_MATCH 0x06 /* \1 \2 ... \9 */ +#define OPAREN 0x07 /* \( */ +#define CPAREN 0x08 /* \) */ +#define ANY_DIGIT 0x09 /* \d */ +#define ANY_NONDIGIT 0x0A /* \D */ +#define ANY_SPACE 0x0B /* \s */ +#define ANY_NONSPACE 0x0C /* \S */ +#define BOW 0x0D /* \< */ +#define EOW 0x0E /* \> */ +#define STAR 0x10 /* * */ +#define LEAST_ONCE 0x20 /* + */ +#define MAYBE_ONCE 0x40 /* ? */ +#define MANY 0x80 /* {n,m} */ + /* The rest are additions */ #define YES_CASE (STAR | BOL) #define NO_CASE (STAR | EOL) @@ -78,14 +79,8 @@ /* FIXME: UTF8 */ static unsigned char Word_Chars256; #define IS_WORD_CHAR(x) Word_Chars(unsigned int) (x) - -#if 0 -static int ctx->open_paren_number; -static char Closed_Paren_Matches10; - -static SLRegexp_Type *This_Reg; -static unsigned char *This_Str; -#endif +static unsigned char Space_Chars256; +#define IS_WHITESPACE(x) (0 != Space_Chars(unsigned int)(x)) typedef struct { @@ -116,6 +111,42 @@ return (str); } +#define CASES(_X, _expr_str) \ + case _X: \ + if ((str >= estr) || (0 == (_expr_str))) return NULL; \ + str++; \ + break; \ + case MAYBE_ONCE | _X: \ + save_str = str; \ + if ((str < estr) && (_expr_str)) str++; \ + goto match_rest; \ + case LEAST_ONCE | _X: \ + if ((str >= estr) || (0 == (_expr_str))) return NULL; \ + str++; \ + /* fall through */ \ + case STAR | _X: \ + save_str = str; \ + while ((str < estr) && (_expr_str)) str++; \ + goto match_rest; \ + case MANY | _X: \ + /* minimum number to match--- could be 0 */ \ + n = n0 = (int) (unsigned char) *regexp++; \ + /* maximum number to match */ \ + n1 = (int) (unsigned char) *regexp++; \ + while (n && (str < estr) && (_expr_str)) \ + { \ + n--; str++; \ + } \ + if (n) return NULL; \ + save_str = str; \ + n = n1 - n0; \ + while (n && (str < estr) && (_expr_str)) \ + { \ + n--; str++; \ + } \ + goto match_rest + + /* returns pointer to the end of regexp or NULL */ static SLCONST unsigned char *regexp_looking_at (Re_Context_Type *ctx, SLCONST unsigned char *str, SLCONST unsigned char *estr, @@ -170,53 +201,7 @@ break; } break; -#ifdef NOT_LITERAL - case NOT_LITERAL: - if ((str >= estr) || (*regexp == UPPERCASE(*str))) return (NULL); - str++; regexp++; - break; - - case MAYBE_ONCE | NOT_LITERAL: - save_str = str; - if ((str < estr) && (*regexp != UPPERCASE(*str))) str++; - regexp++; - goto match_rest; - - case NOT_LITERAL | LEAST_ONCE: /* match at least once */ - if ((str >= estr) || (UPPERCASE(*str) == UPPERCASE(*regexp))) return (NULL); - str++; - /* drop */ - case STAR | NOT_LITERAL: - save_str = str; p1 = *regexp; - while ((str < estr) && (UPPERCASE(*str) != p1)) str++; - regexp++; - goto match_rest; - - /* this type consists of the expression + two bytes that - determine number of matches to perform */ - case MANY | NOT_LITERAL: - p1 = *regexp; regexp++; - n = n0 = (int) (unsigned char) *regexp++; - /* minimum number to match--- could be 0 */ - n1 = (int) (unsigned char) *regexp++; - /* maximum number to match */ - while (n && (str < estr) && (p1 != UPPERCASE(*str))) - { - n--; - str++; - } - if (n) return (NULL); - - save_str = str; - n = n1 - n0; - while (n && (str < estr) && (p1 != UPPERCASE(*str))) - { - n--; - str++; - } - goto match_rest; -#endif /* NOT_LITERAL */ case LITERAL: if ((str >= estr) || (*regexp != UPPERCASE(*str))) return (NULL); str++; regexp++; @@ -231,7 +216,7 @@ case LITERAL | LEAST_ONCE: /* match at least once */ if ((str >= estr) || (UPPERCASE(*str) != UPPERCASE(*regexp))) return (NULL); str++; - /* drop */ + /* fall through */ case STAR | LITERAL: save_str = str; p1 = *regexp; while ((str < estr) && (UPPERCASE(*str) == p1)) str++; @@ -264,7 +249,8 @@ goto match_rest; case NTH_MATCH: - if ((str = do_nth_match(ctx, (int) (unsigned char) *regexp, str, estr)) == NULL) return(NULL); + if (NULL == (str = do_nth_match(ctx, (int) (unsigned char) *regexp, str, estr))) + return(NULL); regexp++; break; @@ -278,7 +264,7 @@ case LEAST_ONCE | NTH_MATCH: if ((str = do_nth_match(ctx, (int) (unsigned char) *regexp, str, estr)) == NULL) return(NULL); - /* drop */ + /* fall through */ case STAR | NTH_MATCH: save_str = str; while (NULL != (tmpstr = do_nth_match(ctx, (int) (unsigned char) *regexp, str, estr))) @@ -328,7 +314,7 @@ case LEAST_ONCE | RANGE: if ((str >= estr) || (0 == TEST_BIT(regexp, UPPERCASE(*str)))) return NULL; str++; - /* drop */ + /* fall through */ case STAR | RANGE: save_str = str; while ((str < estr) && TEST_BIT(regexp, UPPERCASE(*str))) str++; @@ -360,89 +346,11 @@ regexp += 34; /* 32 + 2 */ goto match_rest; - case ANY_DIGIT: - if ((str >= estr) || (*str > '9') || (*str < '0')) return (NULL); - str++; - break; - - case MAYBE_ONCE | ANY_DIGIT: - save_str = str; - if ((str < estr) && ((*str <= '9') && (*str >= '0'))) str++; - goto match_rest; - - case LEAST_ONCE | ANY_DIGIT: - if ((str >= estr) || ((*str > '9') || (*str < '0'))) return NULL; - str++; - /* drop */ - case STAR | ANY_DIGIT: - save_str = str; - while ((str < estr) && ((*str <= '9') && (*str >= '0'))) str++; - goto match_rest; - - case MANY | ANY_DIGIT: - /* minimum number to match--- could be 0 */ - n = n0 = (int) (unsigned char) *regexp++; - /* maximum number to match */ - n1 = (int) (unsigned char) *regexp++; - - while (n && (str < estr) && (*str <= '9') && (*str >= '0')) - { - n--; - str++; - } - if (n) return (NULL); - save_str = str; - n = n1 - n0; - while (n && (str < estr) && (*str <= '9') && (*str >= '0')) - { - n--; - str++; - } - goto match_rest; - - case ANY: /* . */ - /* FIXME: UTF8 */ - if ((str >= estr) || (*str == '\n')) return (NULL); - str++; - break; - - case MAYBE_ONCE | ANY: /* .? */ - /* FIXME: UTF8 */ - save_str = str; - if ((str < estr) && (*str != '\n')) str++; - goto match_rest; - - case LEAST_ONCE | ANY: /* .+ */ - /* FIXME: UTF8 */ - if ((str >= estr) || (*str == '\n')) return (NULL); - str++; - /* drop */ - case STAR | ANY: /* .* */ - /* FIXME: UTF8 */ - save_str = str; - while ((str < estr) && (*str != '\n')) str++; - goto match_rest; - - case MANY | ANY: - /* minimum number to match--- could be 0 */ - n = n0 = (int) (unsigned char) *regexp++; - /* maximum number to match */ - n1 = (int) (unsigned char) *regexp++; - - while (n && (str < estr) && (*str != '\n')) - { - n--; - str++; - } - if (n) return (NULL); - save_str = str; - n = n1 - n0; - while (n && (str < estr) && (*str != '\n')) - { - n--; - str++; - } - goto match_rest; + CASES(ANY_DIGIT, ((*str <= '9') && (*str >= '0'))); + CASES(ANY_NONDIGIT, ((*str > '9') || (*str < '0'))); + CASES(ANY_SPACE, IS_WHITESPACE(*str)); + CASES(ANY_NONSPACE, (0 == IS_WHITESPACE(*str))); + CASES(ANY, (*str != '\n')); case EOL: if (str >= estr) @@ -456,19 +364,13 @@ p = *regexp++; continue; - match_rest: +match_rest: if (save_str == str) { p = *regexp++; continue; } - /* if (p == EOL) - * { - * if (str < estr) return (NULL); else return (str); - * } - */ - SLMEMCPY(save_closed_matches, ctx->closed_paren_matches, sizeof(save_closed_matches)); save_num_open = ctx->open_paren_number; while (str >= save_str) @@ -638,6 +540,7 @@ #else SLmake_lut (Word_Chars, (unsigned char *) "_0-9a-zA-Z\277-\326\330-\336\340-\366\370-\376", 0); #endif + SLmake_lut (Space_Chars, (unsigned char *) "\x09\x0A\x0B\x0C\x0D ", 0); already_initialized = 1; } @@ -714,19 +617,26 @@ last = buf; *buf++ = NTH_MATCH; *buf++ = c; break; -#ifdef NOT_LITERAL - case '~': /* slang extension */ - if ((c = *pat) == 0) ERROR; - pat++; + case 'd': /* slang extension */ last = buf; - *buf++ = NOT_LITERAL; - *buf++ = c; + *buf++ = ANY_DIGIT; min_length++; break; -#endif - case 'd': /* slang extension */ + case 'D': /* slang extension */ last = buf; - *buf++ = ANY_DIGIT; + *buf++ = ANY_NONDIGIT; + min_length++; + break; + + case 's': + last = buf; + *buf++ = ANY_SPACE; + min_length++; + break; + + case 'S': + last = buf; + *buf++ = ANY_NONSPACE; min_length++; break; @@ -1030,7 +940,7 @@ case '?': *b++ = '\\'; if (b == bmax) break; - /* drop */ + /* fall through */ default: *b++ = ch;
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slrline.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slrline.c
Changed
@@ -1,6 +1,6 @@ /* SLang_read_line interface --- uses SLang tty stuff */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -1211,7 +1211,7 @@ if (key->type == SLKEY_F_INTRINSIC) { int (*func)(SLrline_Type *); - func = (int (*)(SLrline_Type *)) key->f.f; + func = (int (*)(SLrline_Type *))(SLFvoid_Star) key->f.f; (void) (*func)(rli); @@ -1361,7 +1361,7 @@ return rl_select_line (This_RLI, next); } -#define AKEY(name,func) {name,(int (*)(void))func} +#define AKEY(name,func) {name,(FVOID_STAR)(SLFvoid_Star)func} static SLKeymap_Function_Type SLReadLine_Functions = { @@ -1436,7 +1436,7 @@ for (ch = ' '; ch < 256; ch++) { simple0 = (char) ch; - SLkm_define_key (simple, (FVOID_STAR) rl_self_insert, km); + SLkm_define_key (simple, (FVOID_STAR)(SLFvoid_Star)rl_self_insert, km); } #else ch = ' '; @@ -1450,61 +1450,61 @@ #endif /* NOT __DECC */ simple0 = SLang_Abort_Char; - SLkm_define_key (simple, (FVOID_STAR) rl_abort, km); + SLkm_define_key (simple, (FVOID_STAR)(SLFvoid_Star)rl_abort, km); #ifdef REAL_UNIX_SYSTEM simple0 = (char) 4; #else simple0 = (char) 26; #endif - SLkm_define_key (simple, (FVOID_STAR) rl_eof_insert, km); + SLkm_define_key (simple, (FVOID_STAR)(SLFvoid_Star) rl_eof_insert, km); #ifndef IBMPC_SYSTEM - SLkm_define_key ("^A", (FVOID_STAR) rl_prev_line, km); - SLkm_define_key ("^B", (FVOID_STAR) rl_next_line, km); - SLkm_define_key ("^C", (FVOID_STAR) rl_right, km); - SLkm_define_key ("^D", (FVOID_STAR) rl_left, km); - SLkm_define_key ("^OA", (FVOID_STAR) rl_prev_line, km); - SLkm_define_key ("^OB", (FVOID_STAR) rl_next_line, km); - SLkm_define_key ("^OC", (FVOID_STAR) rl_right, km); - SLkm_define_key ("^OD", (FVOID_STAR) rl_left, km); + SLkm_define_key ("^A", (FVOID_STAR)(SLFvoid_Star) rl_prev_line, km); + SLkm_define_key ("^B", (FVOID_STAR)(SLFvoid_Star) rl_next_line, km); + SLkm_define_key ("^C", (FVOID_STAR)(SLFvoid_Star) rl_right, km); + SLkm_define_key ("^D", (FVOID_STAR)(SLFvoid_Star) rl_left, km); + SLkm_define_key ("^OA", (FVOID_STAR)(SLFvoid_Star) rl_prev_line, km); + SLkm_define_key ("^OB", (FVOID_STAR)(SLFvoid_Star) rl_next_line, km); + SLkm_define_key ("^OC", (FVOID_STAR)(SLFvoid_Star) rl_right, km); + SLkm_define_key ("^OD", (FVOID_STAR)(SLFvoid_Star) rl_left, km); #else - SLkm_define_key ("^@H", (FVOID_STAR) rl_prev_line, km); - SLkm_define_key ("^@P", (FVOID_STAR) rl_next_line, km); - SLkm_define_key ("^@M", (FVOID_STAR) rl_right, km); - SLkm_define_key ("^@K", (FVOID_STAR) rl_left, km); - SLkm_define_key ("^@S", (FVOID_STAR) rl_del, km); - SLkm_define_key ("^@O", (FVOID_STAR) SLrline_eol, km); - SLkm_define_key ("^@G", (FVOID_STAR) SLrline_bol, km); - - SLkm_define_key ("\xE0H", (FVOID_STAR) rl_prev_line, km); - SLkm_define_key ("\xE0P", (FVOID_STAR) rl_next_line, km); - SLkm_define_key ("\xE0M", (FVOID_STAR) rl_right, km); - SLkm_define_key ("\xE0K", (FVOID_STAR) rl_left, km); - SLkm_define_key ("\xE0S", (FVOID_STAR) rl_del, km); - SLkm_define_key ("\xE0O", (FVOID_STAR) SLrline_eol, km); - SLkm_define_key ("\xE0G", (FVOID_STAR) SLrline_bol, km); + SLkm_define_key ("^@H", (FVOID_STAR)(SLFvoid_Star) rl_prev_line, km); + SLkm_define_key ("^@P", (FVOID_STAR)(SLFvoid_Star) rl_next_line, km); + SLkm_define_key ("^@M", (FVOID_STAR)(SLFvoid_Star) rl_right, km); + SLkm_define_key ("^@K", (FVOID_STAR)(SLFvoid_Star) rl_left, km); + SLkm_define_key ("^@S", (FVOID_STAR)(SLFvoid_Star) rl_del, km); + SLkm_define_key ("^@O", (FVOID_STAR)(SLFvoid_Star) SLrline_eol, km); + SLkm_define_key ("^@G", (FVOID_STAR)(SLFvoid_Star) SLrline_bol, km); + + SLkm_define_key ("\xE0H", (FVOID_STAR)(SLFvoid_Star) rl_prev_line, km); + SLkm_define_key ("\xE0P", (FVOID_STAR)(SLFvoid_Star) rl_next_line, km); + SLkm_define_key ("\xE0M", (FVOID_STAR)(SLFvoid_Star) rl_right, km); + SLkm_define_key ("\xE0K", (FVOID_STAR)(SLFvoid_Star) rl_left, km); + SLkm_define_key ("\xE0S", (FVOID_STAR)(SLFvoid_Star) rl_del, km); + SLkm_define_key ("\xE0O", (FVOID_STAR)(SLFvoid_Star) SLrline_eol, km); + SLkm_define_key ("\xE0G", (FVOID_STAR)(SLFvoid_Star) SLrline_bol, km); #endif - SLkm_define_key ("^C", (FVOID_STAR) rl_abort, km); - SLkm_define_key ("^E", (FVOID_STAR) SLrline_eol, km); - SLkm_define_key ("^G", (FVOID_STAR) rl_abort, km); - SLkm_define_key ("^I", (FVOID_STAR) rl_complete, km); - SLkm_define_key ("^A", (FVOID_STAR) SLrline_bol, km); - SLkm_define_key ("\r", (FVOID_STAR) rl_enter, km); - SLkm_define_key ("\n", (FVOID_STAR) rl_enter, km); - SLkm_define_key ("^K", (FVOID_STAR) rl_deleol, km); - SLkm_define_key ("^L", (FVOID_STAR) rl_deleol, km); - SLkm_define_key ("^U", (FVOID_STAR) rl_delbol, km); - SLkm_define_key ("^V", (FVOID_STAR) rl_del, km); - SLkm_define_key ("^D", (FVOID_STAR) rl_del, km); - SLkm_define_key ("^F", (FVOID_STAR) rl_right, km); - SLkm_define_key ("^B", (FVOID_STAR) rl_left, km); - SLkm_define_key ("^?", (FVOID_STAR) rl_bdel, km); - SLkm_define_key ("^H", (FVOID_STAR) rl_bdel, km); - SLkm_define_key ("^P", (FVOID_STAR) rl_prev_line, km); - SLkm_define_key ("^N", (FVOID_STAR) rl_next_line, km); - SLkm_define_key ("^R", (FVOID_STAR) rl_redraw, km); - SLkm_define_key ("`", (FVOID_STAR) rl_quote_insert, km); - SLkm_define_key ("\033\\", (FVOID_STAR) rl_trim, km); + SLkm_define_key ("^C", (FVOID_STAR)(SLFvoid_Star) rl_abort, km); + SLkm_define_key ("^E", (FVOID_STAR)(SLFvoid_Star) SLrline_eol, km); + SLkm_define_key ("^G", (FVOID_STAR)(SLFvoid_Star) rl_abort, km); + SLkm_define_key ("^I", (FVOID_STAR)(SLFvoid_Star) rl_complete, km); + SLkm_define_key ("^A", (FVOID_STAR)(SLFvoid_Star) SLrline_bol, km); + SLkm_define_key ("\r", (FVOID_STAR)(SLFvoid_Star) rl_enter, km); + SLkm_define_key ("\n", (FVOID_STAR)(SLFvoid_Star) rl_enter, km); + SLkm_define_key ("^K", (FVOID_STAR)(SLFvoid_Star) rl_deleol, km); + SLkm_define_key ("^L", (FVOID_STAR)(SLFvoid_Star) rl_deleol, km); + SLkm_define_key ("^U", (FVOID_STAR)(SLFvoid_Star) rl_delbol, km); + SLkm_define_key ("^V", (FVOID_STAR)(SLFvoid_Star) rl_del, km); + SLkm_define_key ("^D", (FVOID_STAR)(SLFvoid_Star) rl_del, km); + SLkm_define_key ("^F", (FVOID_STAR)(SLFvoid_Star) rl_right, km); + SLkm_define_key ("^B", (FVOID_STAR)(SLFvoid_Star) rl_left, km); + SLkm_define_key ("^?", (FVOID_STAR)(SLFvoid_Star) rl_bdel, km); + SLkm_define_key ("^H", (FVOID_STAR)(SLFvoid_Star) rl_bdel, km); + SLkm_define_key ("^P", (FVOID_STAR)(SLFvoid_Star) rl_prev_line, km); + SLkm_define_key ("^N", (FVOID_STAR)(SLFvoid_Star) rl_next_line, km); + SLkm_define_key ("^R", (FVOID_STAR)(SLFvoid_Star) rl_redraw, km); + SLkm_define_key ("`", (FVOID_STAR)(SLFvoid_Star) rl_quote_insert, km); + SLkm_define_key ("\033\\", (FVOID_STAR)(SLFvoid_Star) rl_trim, km); if (_pSLang_Error) return -1; RL_Keymap = km; @@ -2099,14 +2099,14 @@ if (Active_Rline_Info == NULL) return; - if (NULL == (f = (int (*)(SLrline_Type *)) (SLang_find_key_function(fun, Active_Rline_Info->keymap)))) + if (NULL == (f = (int (*)(SLrline_Type *))(SLFvoid_Star)SLang_find_key_function(fun, Active_Rline_Info->keymap))) { _pSLang_verror (SL_UndefinedName_Error, "rline internal function %s does not exist", fun); return; } (void) (*f)(Active_Rline_Info); - /* Active_Rline_Info->last_fun = (FVOID_STAR) f; */ + /* Active_Rline_Info->last_fun = (FVOID_STAR)(SLFvoid_Star) f; */ } static void rline_get_line_intrinsic (void) @@ -2327,6 +2327,8 @@ (void) SLang_push_function (last_key->f.slang_fun); return; } + break; + case SLKEY_F_KEYSYM: (void) SLang_push_uint (last_key->f.keysym); return;
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slscanf.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slscanf.c
Changed
@@ -1,6 +1,6 @@ /* sscanf function for S-Lang */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -175,7 +175,7 @@ *xp = sign * strtod_l (buf, NULL, C_Locale); return 1; } - /* drop */ + /* fall through */ # endif # ifdef HAVE_STRTOD @@ -646,6 +646,7 @@ goto return_error; case 'D': is_long = 1; + /* fall through */ case 'd': if (is_short) { @@ -666,6 +667,7 @@ case 'U': is_long = 1; + /* fall through */ case 'u': if (is_short) { @@ -686,7 +688,7 @@ case 'I': is_long = 1; - /* drop */ + /* fall through */ case 'i': if ((s + 1 >= smax) || (*s != '0')) @@ -703,7 +705,7 @@ case 'O': is_long = 1; - /* drop */ + /* fall through */ case 'o': map = map8; base = 8; @@ -715,7 +717,7 @@ case 'X': is_long = 1; - /* drop */ + /* fall through */ case 'x': base = 16; map = map16; @@ -728,7 +730,7 @@ case 'E': case 'F': is_long = 1; - /* drop */ + /* fall through */ case 'e': case 'f': case 'g':
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slscroll.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slscroll.c
Changed
@@ -1,6 +1,6 @@ /* SLang Scrolling Window Routines */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slsearch.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slsearch.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slsig.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slsig.c
Changed
@@ -1,6 +1,6 @@ /* interpreter signal handling functions */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -747,7 +747,7 @@ case 3: if (-1 == SLang_pop_double (&interval)) goto free_and_return; - /* drop */ + /* fall through */ case 2: default: if ((-1 == SLang_pop_double (&value))
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slsignal.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slsignal.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slsmg.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slsmg.c
Changed
@@ -1,6 +1,6 @@ /* SLang Screen management routines */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -41,9 +41,14 @@ #define TRASHED 0x2 static int Screen_Trashed; -static Screen_Type SL_ScreenSLTT_MAX_SCREEN_ROWS; +#define DEFAULT_NUM_SCREEN_ROWS (25) +static Screen_Type SL_Screen_StaticDEFAULT_NUM_SCREEN_ROWS; +static Screen_Type *SL_Screen = SL_Screen_Static; +static unsigned int SL_Screen_Num_Rows = DEFAULT_NUM_SCREEN_ROWS; + +static unsigned int Screen_Rows; +static unsigned int Screen_Cols; static int Start_Col, Start_Row; -static unsigned int Screen_Cols, Screen_Rows; static int This_Row, This_Col; static SLsmg_Color_Type This_Color; @@ -317,7 +322,7 @@ break; } mode = ACS_MODE_ASCII; - /* drop */ + /* fall through */ case ACS_MODE_ASCII: default: acs = UTF8_ACS_Map; @@ -1560,8 +1565,9 @@ static int init_smg (int mode) { - unsigned int i, len; SLsmg_Char_Type *old, *neew; + unsigned int num_screen_rows; + unsigned int i, len; Smg_Mode = mode; @@ -1569,10 +1575,22 @@ Bce_Color_Offset = _pSLtt_get_bce_color_offset (); #endif - Screen_Rows = *tt_Screen_Rows; - if (Screen_Rows > SLTT_MAX_SCREEN_ROWS) - Screen_Rows = SLTT_MAX_SCREEN_ROWS; + num_screen_rows = *tt_Screen_Rows; + if (num_screen_rows <= SL_Screen_Num_Rows) + Screen_Rows = num_screen_rows; + else + { + Screen_Type *s; + if (NULL != (s = (Screen_Type *)SLmalloc (num_screen_rows*sizeof(Screen_Type)))) + { + SL_Screen_Num_Rows = num_screen_rows; + if (SL_Screen != SL_Screen_Static) + SLfree ((char *)SL_Screen); + SL_Screen = s; + Screen_Rows = num_screen_rows; + } + } Screen_Cols = *tt_Screen_Cols; This_Col = This_Row = Start_Col = Start_Row = 0;
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slstd.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slstd.c
Changed
@@ -2,7 +2,7 @@ /* Standard intrinsic functions for S-Lang. Included here are string and array operations */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slstdio.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slstdio.c
Changed
@@ -1,6 +1,6 @@ /* file stdio intrinsics for S-Lang */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -266,7 +266,7 @@ && (0 == SLang_push_mmt (mmt))) return 0; - /* drop */ + /* fall through */ return_error: if (fp != NULL) (*close_fun) (fp); @@ -473,10 +473,13 @@ return ret; } -static int read_one_line (FILE *fp, char **strp, SLstrlen_Type *lenp, int trim_trailing) +/* If trim = 1, trim trailing whitespace, if 2 trim leading, if 3 trim both */ +#define TRIM_TRAILING (0x1) +#define TRIM_LEADING (0x2) +static int read_one_line (FILE *fp, char **strp, SLstrlen_Type *lenp, int trim) { char buf512; - char *str; + char *str, *str0; size_t len; *strp = NULL; @@ -520,7 +523,7 @@ if (str == NULL) return 0; - if (trim_trailing) + if (trim & TRIM_TRAILING) { unsigned int len1 = len; while (len1) @@ -535,8 +538,18 @@ len = len1; } + str0 = str; + if (trim & TRIM_LEADING) + { + unsigned int i = 0; + while ((i < len) && (isspace ((unsigned char) stri))) + i++; + str += i; + len -= i; + } + *strp = SLang_create_nslstring (str, len); - if (str != buf) SLfree (str); + if (str0 != buf) SLfree (str0); if (*strp == NULL) return -1; @@ -569,7 +582,7 @@ return (int) len; } -static void stdio_fgetslines_internal (FILE *fp, unsigned int n) +static void stdio_fgetslines_internal (FILE *fp, unsigned int n, int trim) { unsigned int num_lines, max_num_lines; char **list; @@ -596,7 +609,7 @@ char *line; SLstrlen_Type len; - status = read_one_line (fp, &line, &len, 0); + status = read_one_line (fp, &line, &len, trim); if (status == -1) goto return_error; @@ -656,9 +669,10 @@ static void stdio_fgetslines (void) { - unsigned int n; FILE *fp; SLang_MMT_Type *mmt; + unsigned int n; + int trim; n = (unsigned int)-1; @@ -674,7 +688,9 @@ return; } - stdio_fgetslines_internal (fp, n); + if (0 == SLang_get_int_qualifier ("trim", &trim, 0)) + stdio_fgetslines_internal (fp, n, trim); + SLang_free_mmt (mmt); } @@ -889,7 +905,7 @@ SLang_free_array (at); } s = NULL; - /* drop */ + /* fall through */ the_return: if (s != NULL) SLfree (s); @@ -953,7 +969,7 @@ if ((ret == -1) && ferror (fp)) _pSLerrno_errno = errno; - /* drop */ + /* fall through */ the_return: if (b != NULL) SLbstring_free (b);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slstring.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slstring.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -126,16 +126,26 @@ switch(len) /* all the case statements fall through */ { case 11: c+=((_pSLuint32_Type)s10<<24); + /* fall through */ case 10: c+=((_pSLuint32_Type)s9<<16); + /* fall through */ case 9 : c+=((_pSLuint32_Type)s8<<8); + /* fall through */ /* the first byte of c is reserved for the length */ case 8 : b+=((_pSLuint32_Type)s7<<24); + /* fall through */ case 7 : b+=((_pSLuint32_Type)s6<<16); + /* fall through */ case 6 : b+=((_pSLuint32_Type)s5<<8); + /* fall through */ case 5 : b+=s4; + /* fall through */ case 4 : a+=((_pSLuint32_Type)s3<<24); + /* fall through */ case 3 : a+=((_pSLuint32_Type)s2<<16); + /* fall through */ case 2 : a+=((_pSLuint32_Type)s1<<8); + /* fall through */ case 1 : a+=s0; /* case 0: nothing left to add */ }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slstrops.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slstrops.c
Changed
@@ -1,7 +1,7 @@ /* -*- mode: C; mode: fold; -*- */ /* string manipulation functions for S-Lang. */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -875,7 +875,7 @@ goto free_and_return; } (void) SLang_push_wchar (wch); - /* drop */ + /* fall through */ free_and_return: SLang_free_slstring ((char *)str); } @@ -913,7 +913,7 @@ goto free_and_return; } (void) SLang_push_wchar (wch); - /* drop */ + /* fall through */ free_and_return: SLang_free_slstring ((char *)str); } @@ -1221,11 +1221,11 @@ for (i = 0; i < num; i++) int_at_datai = (*func)(aos.str, bos.spi, cd); - /* drop */ + /* fall through */ push_and_return: status = SLang_push_array (int_at, 1); - /* drop */ + /* fall through */ free_and_return: free_array_or_string (&aos); free_array_or_string (&bos); @@ -1323,6 +1323,7 @@ SLstrlen_Type n; char *c; + if ((a == NULL) || (b == NULL)) return 0; (void) cd; if (NULL == (c = strstr(a, b))) @@ -1955,6 +1956,12 @@ * to be. */ want_width = width = 0; + if (ch == '0') + { + *f++ = '0'; + ch = *p++; + } + if (ch == '*') { if (SLang_pop_uinteger(&width)) return (out); @@ -1963,12 +1970,6 @@ } else { - if (ch == '0') - { - *f++ = '0'; - ch = *p++; - } - while ((ch <= '9') && (ch >= '0')) { width = width * 10 + (ch - '0'); @@ -2054,12 +2055,12 @@ f1--; } - /* drop */ + /* fall through */ case 'S': if (ch == 'S') _pSLstring_intrinsic (); ch = 's'; - /* drop */ + /* fall through */ case 's': if (-1 == SLang_pop_slstring(&str)) return (out); @@ -2164,7 +2165,7 @@ /* Pointer type?? Why?? */ if (-1 == SLdo_pop ()) return out; - str = (char *) _pSLang_get_run_stack_pointer (); + str = ((char *)NULL + SLstack_depth ()); use_string = 1; use_long = 0; break; @@ -2234,21 +2235,18 @@ { char *p; char *fmt; - SLang_Object_Type *ptr; int ofs; if (-1 == (ofs = SLreverse_stack (n + 1))) return -1; - ptr = _pSLang_get_run_stack_base () + ofs; - if (SLang_pop_slstring(&fmt)) return -1; p = SLdo_sprintf (fmt); _pSLang_free_slstring (fmt); - SLdo_pop_n (_pSLang_get_run_stack_pointer () - ptr); + SLdo_pop_n (SLstack_depth () - ofs); if (_pSLang_Error) { @@ -2413,32 +2411,95 @@ /*}}}*/ /* Regular expression routines for strings */ -static SLRegexp_Type *Regexp; -static unsigned int Regexp_Match_Byte_Offset; +#define NUM_CACHED_REGEXP 5 +typedef struct +{ + SLRegexp_Type *regexp; + char *pattern; + unsigned int match_byte_offset; +} +Regexp_Type; +static unsigned int Cache_IndicesNUM_CACHED_REGEXP; +static Regexp_Type Regexp_CacheNUM_CACHED_REGEXP; -static int string_match_internal (char *str, char *pat, int n) /*{{{*/ +static int init_regexp_cache (void) { - char *match; - size_t len; - size_t byte_offset; + unsigned int i; - if (Regexp != NULL) + for (i = 0; i < NUM_CACHED_REGEXP; i++) + Cache_Indicesi = i; + + return 0; +} + +static Regexp_Type *get_regexp (char *pat) +{ + Regexp_Type *r; + unsigned int i, j; + + for (i = 0; i < NUM_CACHED_REGEXP; i++) { - SLregexp_free (Regexp); - Regexp = NULL; + r = Regexp_Cache + Cache_Indicesi; + if (r->pattern != pat) continue; /* slstring comparison */ + + if ((r->regexp == NULL) + && (NULL == (r->regexp = SLregexp_compile (pat, 0)))) + return NULL; + + goto update_cache_and_return; } + /* Here, r is set to Regexp_Cache + Cache_Indicesi */ + + SLang_free_slstring (r->pattern); /* NULL ok */ + if (NULL == (r->pattern = SLang_create_slstring (pat))) + return NULL; + + SLregexp_free (r->regexp); /* NULL ok */ + if (NULL == (r->regexp = SLregexp_compile (pat, 0))) + return NULL; + + /* Drop */ + +update_cache_and_return: + i = r - Regexp_Cache; + if (i == Cache_Indices0) return r; + + j = 1; + while (j < NUM_CACHED_REGEXP) + { + if (i != Cache_Indicesj) + { + j++; + continue; + } + + while (j > 0) + { + Cache_Indicesj = Cache_Indicesj-1; + j--; + } + Cache_Indices0 = i; + break; + } + return r; +} + +static int string_match_internal (char *str, Regexp_Type *r, int n) /*{{{*/ +{ + char *match; + size_t len; + size_t byte_offset; + byte_offset = (unsigned int) (n - 1); len = strlen(str); if (byte_offset > len) return 0; - if (NULL == (Regexp = SLregexp_compile (pat, 0))) - return -1; - Regexp_Match_Byte_Offset = byte_offset; + r->match_byte_offset = byte_offset; - if (NULL == (match = SLregexp_match (Regexp, str+byte_offset, len-byte_offset))) + if (NULL == (match = SLregexp_match (r->regexp, str+byte_offset, len-byte_offset))) return 0; return 1 + (int) (match - str); @@ -2469,13 +2530,18 @@ static int string_match_cmd (void) { + Regexp_Type *r; char *str, *pat; int n, status; if (-1 == pop_string_match_args (SLang_Num_Function_Args, &str, &pat, &n)) return -1; - status = string_match_internal (str, pat, n); + if (NULL == (r = get_regexp (pat))) + status = -1; + else + status = string_match_internal (str, r, n); + SLang_free_slstring (str); SLang_free_slstring (pat); return status; @@ -2484,20 +2550,22 @@ static int string_match_nth_cmd (int *nptr) /*{{{*/ { SLuindex_Type ofs, len; + Regexp_Type *r; - if (Regexp == NULL) + r = Regexp_Cache + Cache_Indices0; + if (r->regexp == NULL) { _pSLang_verror (SL_RunTime_Error, "A successful call to string_match was not made"); return -1; } - if (-1 == SLregexp_nth_match (Regexp, (unsigned int) *nptr, &ofs, &len)) + if (-1 == SLregexp_nth_match (r->regexp, (unsigned int) *nptr, &ofs, &len)) { _pSLang_verror (0, "SLregexp_nth_match failed"); return -1; } - ofs += Regexp_Match_Byte_Offset; + ofs += r->match_byte_offset; /* zero based return value */ SLang_push_integer((int) ofs); @@ -2508,15 +2576,19 @@ static int string_matches_internal (char *str, char *pat, int n) { - int status; - SLuindex_Type i; SLstrlen_Type lens10; SLstrlen_Type offsets10; + Regexp_Type *r; char **strs; - SLindex_Type num; SLang_Array_Type *at; + SLindex_Type num; + SLuindex_Type i; + int status; - status = string_match_internal (str, pat, n); + if (NULL == (r = get_regexp (pat))) + return -1; + + status = string_match_internal (str, r, n); if (status <= 0) { SLang_push_null (); @@ -2525,9 +2597,9 @@ for (i = 0; i < 10; i++) { - if (-1 == SLregexp_nth_match (Regexp, i, offsets+i, lens+i)) + if (-1 == SLregexp_nth_match (r->regexp, i, offsets+i, lens+i)) break; - offsetsi += Regexp_Match_Byte_Offset; + offsetsi += r->match_byte_offset; } num = (SLindex_Type)i; @@ -2644,7 +2716,7 @@ } str = create_delimited_string (strings + 1, (n - 1), strings0); - /* drop */ + /* fall through */ return_error: for (i = 0; i < n; i++) _pSLang_free_slstring (stringsi); SLfree ((char *)strings); @@ -2872,11 +2944,11 @@ if (-1 == SLang_pop_int (&nmax)) return; has_nmax = 1; - /* drop */ + /* fall through */ case 3: if (-1 == SLang_pop_int (&n0)) return; - /* drop */ + /* fall through */ default: if (-1 == SLang_pop_slstring (&chars)) return; @@ -2916,7 +2988,7 @@ goto free_and_return; (void) SLang_push_integer ((int)((char *)strmax - str)); - /* drop */ + /* fall through */ free_and_return: SLang_free_slstring (str); @@ -3126,5 +3198,7 @@ int _pSLang_init_slstrops (void) { + if (-1 == init_regexp_cache ()) return -1; + return SLadd_intrin_fun_table (Strops_Table, NULL); }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slstruct.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slstruct.c
Changed
@@ -1,6 +1,6 @@ /* Structure type implementation */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -1291,7 +1291,7 @@ while (list->next != NULL) list = list->next; list->next = item; } - /* drop */ + /* fall through */ } SLang_free_function (item->binary_func); item->binary_func = nt; @@ -1997,7 +1997,7 @@ case 2: if (-1 == SLang_pop_array_of_type (&at, SLANG_STRING_TYPE)) return; - /* drop */ + /* fall through */ case 1: if (-1 == SLang_pop_struct (&s)) { @@ -2429,7 +2429,7 @@ } s = create_struct (n, field_names, field_types, field_values); - /* drop */ + /* fall through */ return_error: SLfree ((char *) field_values);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/sltermin.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/sltermin.c
Changed
@@ -3,7 +3,7 @@ */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -93,6 +93,26 @@ #define MAGIC_LEGACY 0432 #define MAGIC_32BIT 01036 +typedef struct +{ + int num_bool; + char **bool_caps; /* malloced */ + unsigned char *bool_values; /* malloced */ + + int num_numeric; + char **numeric_caps; /* NOT malloced */ + unsigned char *numeric_values; /* malloced */ + + int num_string; + char **string_caps; /* NOT malloced */ + unsigned char *string_offsets; /* malloced */ + + char *heap; /* malloced */ + char *cap_name_heap; /* NOT malloced */ +} +Extended_Cap_Type; + + /* In this structure, all char * fields are malloced EXCEPT if the * structure is SLTERMCAP. In that case, only terminal_names is malloced * and the other fields are pointers into it. @@ -120,6 +140,9 @@ unsigned int string_table_size; char *string_table; + size_t read_offset; /* number of bytes currently read */ + + Extended_Cap_Type *ext; }; static char *tcap_getstr (SLCONST char *, SLterminfo_Type *); @@ -133,6 +156,9 @@ unsigned char buf12; int magic; +#ifdef SLANG_UNTIC + (void) fprintf (stdout,"# Trying %s\n", file); +#endif /* Alan Cox reported a security problem here if the application using the * library is setuid. So, I need to make sure open the file as a normal * user. Unfortunately, there does not appear to be a portable way of @@ -173,6 +199,8 @@ h->num_string_offsets = make_integer16 (buf + 8); h->string_table_size = make_integer16 (buf + 10); + h->read_offset = 12; + return fp; } @@ -184,7 +212,7 @@ */ /* returns pointer to malloced space */ -static unsigned char *read_terminfo_section (FILE *fp, unsigned int size) +static void *read_terminfo_section (FILE *fp, SLterminfo_Type *t, unsigned int size) { char *s; @@ -194,12 +222,14 @@ SLfree (s); return NULL; } + t->read_offset += size; + return (unsigned char *) s; } static char *read_terminal_names (FILE *fp, SLterminfo_Type *t) { - return t->terminal_names = (char *) read_terminfo_section (fp, t->name_section_size); + return t->terminal_names = (char *) read_terminfo_section (fp, t, t->name_section_size); } /* @@ -220,7 +250,7 @@ unsigned int size = (t->name_section_size + t->boolean_section_size) % 2; size += t->boolean_section_size; - return t->boolean_flags = read_terminfo_section (fp, size); + return t->boolean_flags = (unsigned char *)read_terminfo_section (fp, t, size); } /* @@ -232,7 +262,7 @@ static unsigned char *read_numbers (FILE *fp, SLterminfo_Type *t) { - return t->numbers = read_terminfo_section (fp, t->sizeof_number * t->num_numbers); + return t->numbers = (unsigned char *)read_terminfo_section (fp, t, t->sizeof_number * t->num_numbers); } /* The strings section is also similar. Each capability is stored as a @@ -246,7 +276,7 @@ static unsigned char *read_string_offsets (FILE *fp, SLterminfo_Type *t) { - return t->string_offsets = (unsigned char *) read_terminfo_section (fp, 2 * t->num_string_offsets); + return t->string_offsets = (unsigned char *) read_terminfo_section (fp, t, 2 * t->num_string_offsets); } /* The final section is the string table. It contains all the values of @@ -256,7 +286,133 @@ static char *read_string_table (FILE *fp, SLterminfo_Type *t) { - return t->string_table = (char *) read_terminfo_section (fp, t->string_table_size); + return t->string_table = (char *) read_terminfo_section (fp, t, t->string_table_size); +} + +static void free_ext_caps (Extended_Cap_Type *ext) +{ + if (ext == NULL) return; + + SLfree ((char *)ext->bool_values); + SLfree ((char *)ext->numeric_values); + SLfree ((char *)ext->string_offsets); + SLfree ((char *)ext->heap); + SLfree ((char *)ext->bool_caps); + + SLfree ((char *)ext); +} + +static int try_read_extended_caps (FILE *fp, SLterminfo_Type *t) +{ + Extended_Cap_Type *ext; + size_t size; + char **cap_names; + unsigned char *b; + char *heap_max, *cap_name_heap; + unsigned int i, num_caps, heap_size; + unsigned char buf11; + + size = 10; + b = buf; + if (t->read_offset % 2) + { + size++; + b++; + } + + if (size != fread (buf, 1, size, fp)) + return 0; /* assume no extended caps */ + t->read_offset += size; + + if (NULL == (ext = (Extended_Cap_Type *)SLmalloc (sizeof(Extended_Cap_Type)))) + return -1; + memset (ext, 0, sizeof(Extended_Cap_Type)); + + ext->num_bool = make_integer16(b); + ext->num_numeric = make_integer16(b+2); + ext->num_string = make_integer16(b+4); + (void) make_integer16(b+6); /* number of valid strings (not cancelled or absent) */ + heap_size = make_integer16(b+8); /* size of the area containing all strings */ + + /* The heap should be large enough to hold all the strings */ + num_caps = ext->num_bool + ext->num_numeric + ext->num_string; + if ((ext->num_bool < 0) || (ext->num_numeric < 0) || (ext->num_string < 0) + || (heap_size < 2*(num_caps + ext->num_string))) + goto return_failure; + + size = ext->num_bool; + if (size % 2) size++; /* so numbers will start on an even byte bndry */ + if (NULL == (ext->bool_values = (unsigned char *)read_terminfo_section (fp, t, size))) + goto return_failure; + + size = t->sizeof_number * ext->num_numeric; + if (NULL == (ext->numeric_values = (unsigned char *)read_terminfo_section (fp, t, size))) + goto return_failure; + + /* Now read the offsets for the strings. These also include offsets for all + * capability names. + */ + size = 2 * ext->num_string; + /* Now add the offsets for _all_ the extended cap names */ + size += 2 * num_caps; + if (NULL == (ext->string_offsets = (unsigned char *)read_terminfo_section (fp, t, size))) + goto return_failure; + + /* Now read the heap that contains all the strings. The heaps contains two + * areas: the first contains the values the string-valued capabilities. The + * seccond area contains the names of all the extended capabilities. Unfortunately + * the file format lacks explicit information about where the second area begins. + * So it will have to be deduced. + */ + if (NULL == (ext->heap = (char *)read_terminfo_section (fp, t, heap_size))) + goto return_failure; + heap_max = ext->heap + heap_size; + + /* The whole point of this next loop is to find the cap_name_heap. This info + * should have been put in the header. + */ + cap_name_heap = ext->heap; + b = ext->string_offsets; + for (i = 0; i < (unsigned int)ext->num_string; i++) + { + int offset = make_integer16 (b); + if (((offset >= 0) && ((unsigned int)offset < heap_size)) + && (ext->heap + offset >= cap_name_heap)) + { + cap_name_heap = ext->heap + offset; + while ((cap_name_heap < heap_max) + && (*cap_name_heap != 0)) + cap_name_heap++; + if (cap_name_heap < heap_max) cap_name_heap++; /* skip \0 */ + } + b += 2; + } + + if (NULL == (cap_names = (char **)SLmalloc(num_caps * sizeof(char *)))) + goto return_failure; + + for (i = 0; i < num_caps; i++) + { + int offset = make_integer16 (b); + + if ((offset < 0) + || ((cap_namesi = cap_name_heap + offset) >= heap_max)) + cap_namesi = "*invalid*"; + + b += 2; + } + ext->cap_name_heap = cap_name_heap; + + ext->bool_caps = cap_names; + ext->numeric_caps = cap_names + ext->num_bool; + ext->string_caps = ext->numeric_caps + ext->num_numeric; + + t->ext = ext; + return 0; + +return_failure: + free_ext_caps (ext); + return 0; /* we tried */ } /* @@ -269,10 +425,73 @@ * are implemented by multiple links to the same compiled file. */ +static FILE *try_open_tidir (SLterminfo_Type *ti, const char *tidir, const char *term) +{ + char file1024; + + if (sizeof (file) > strlen (tidir) + 5 + strlen (term)) + { + FILE *fp; + + sprintf (file, "%s/%c/%s", tidir, *term, term); + if (NULL != (fp = open_terminfo (file, ti))) + return fp; + + sprintf (file, "%s/%02x/%s", tidir, (unsigned char)*term, term); + if (NULL != (fp = open_terminfo (file, ti))) + return fp; + } + + return NULL; +} + +static FILE *try_open_env (SLterminfo_Type *ti, const char *term, const char *envvar) +{ + char *tidir; + + if (NULL == (tidir = _pSLsecure_getenv (envvar))) + return NULL; + + return try_open_tidir (ti, tidir, term); +} + +static FILE *try_open_home (SLterminfo_Type *ti, const char *term) +{ + char home_ti1024; + char *env; + + if (NULL == (env = _pSLsecure_getenv ("HOME"))) + return NULL; + + strncpy (home_ti, env, sizeof (home_ti) - 11); + home_ti sizeof(home_ti) - 11 = 0; + strcat (home_ti, "/.terminfo"); + + return try_open_tidir (ti, home_ti, term); +} + +static FILE *try_open_env_path (SLterminfo_Type *ti, const char *term, const char *envvar) +{ + char tidir1024; + char *env; + unsigned int i; + + if (NULL == (env = _pSLsecure_getenv (envvar))) + return NULL; + + i = 0; + while (-1 != SLextract_list_element (env, i, ':', tidir, sizeof(tidir))) + { + FILE *fp = try_open_tidir (ti, tidir, term); + if (fp != NULL) return fp; + i++; + } + + return NULL; +} + static SLCONST char *Terminfo_Dirs = { - "", /* $TERMINFO */ - "", /* $HOME/.terminfo */ #ifdef MISC_TERMINFO_DIRS MISC_TERMINFO_DIRS, #endif @@ -287,6 +506,23 @@ NULL, }; +static FILE *try_open_hardcoded (SLterminfo_Type *ti, const char *term) +{ + const char *tidir, **tidirs; + + tidirs = Terminfo_Dirs; + while (NULL != (tidir = *tidirs++)) + { + FILE *fp; + + if ((*tidir != 0) + && (NULL != (fp = try_open_tidir (ti, tidir, term)))) + return fp; + } + + return NULL; +} + void _pSLtt_tifreeent (SLterminfo_Type *t) { if (t == NULL) @@ -298,6 +534,7 @@ SLfree ((char *)t->string_offsets); SLfree ((char *)t->numbers); SLfree ((char *)t->boolean_flags); + free_ext_caps (t->ext); } SLfree ((char *)t->terminal_names); SLfree ((char *)t); @@ -305,11 +542,7 @@ SLterminfo_Type *_pSLtt_tigetent (SLCONST char *term) { - SLCONST char **tidirs, *tidir; FILE *fp = NULL; - char file1024; - static char home_ti 1024; - char *env; SLterminfo_Type *ti; if ( @@ -341,36 +574,13 @@ /* If we are on a termcap based system, use termcap */ if (0 == tcap_getent (term, ti)) return ti; - if (NULL != (env = _pSLsecure_getenv ("TERMINFO"))) - Terminfo_Dirs0 = env; - - if (NULL != (env = _pSLsecure_getenv ("HOME"))) - { - strncpy (home_ti, env, sizeof (home_ti) - 11); - home_ti sizeof(home_ti) - 11 = 0; - strcat (home_ti, "/.terminfo"); - Terminfo_Dirs 1 = home_ti; - } - - tidirs = Terminfo_Dirs; - while (NULL != (tidir = *tidirs++)) - { - if (*tidir == 0) - continue; - - if (sizeof (file) > strlen (tidir) + 5 + strlen (term)) - { - sprintf (file, "%s/%c/%s", tidir, *term, term); - if (NULL != (fp = open_terminfo (file, ti))) - break; - sprintf (file, "%s/%02x/%s", tidir, (unsigned char)*term, term); - if (NULL != (fp = open_terminfo (file, ti))) - break; - } - } + fp = try_open_env_path (ti, term, "TERMINFO_DIRS"); + if (fp == NULL) fp = try_open_env (ti, term, "TERMINFO"); + if (fp == NULL) fp = try_open_home (ti, term); + if (fp == NULL) fp = try_open_hardcoded (ti, term); #ifdef SLANG_UNTIC - fp_open_label: +fp_open_label: #endif if (fp == NULL) @@ -384,7 +594,8 @@ || (NULL == read_boolean_flags (fp, ti)) || (NULL == read_numbers (fp, ti)) || (NULL == read_string_offsets (fp, ti)) - || (NULL == read_string_table (fp, ti))) + || (NULL == read_string_table (fp, ti)) + || (-1 == try_read_extended_caps (fp, ti))) { _pSLtt_tifreeent (ti); ti = NULL; @@ -416,7 +627,11 @@ char cha, chb; (void) t; - cha = *cap++; chb = *cap; + + /* cap must be at most 2 characters */ + if ((0 == (cha = cap0)) + || ((0 != (chb = cap1)) && (0 != cap2))) + return -1; while (*map->name != 0) { @@ -432,13 +647,33 @@ char *_pSLtt_tigetstr (SLterminfo_Type *t, SLCONST char *cap) { - int offset; + int i, offset; if (t == NULL) return NULL; if (t->flags == SLTERMCAP) return tcap_getstr (cap, t); + /* Check local extensions first */ + if (t->ext != NULL) + { + Extended_Cap_Type *e = t->ext; + int n = e->num_string; + + for (i = 0; i < n; i++) + { + char *val; + if (strcmp (cap, e->string_capsi)) + continue; + + offset = make_integer16 (e->string_offsets + 2*i); + if (offset < 0) return NULL; + val = e->heap + offset; + if (val >= e->cap_name_heap) return NULL; + return val; + } + } + offset = compute_cap_offset (cap, t, Tgetstr_Map, t->num_string_offsets); if (offset < 0) return NULL; offset = make_integer16 (t->string_offsets + 2 * offset); @@ -455,6 +690,19 @@ if (t->flags == SLTERMCAP) return tcap_getnum (cap, t); + if (t->ext != NULL) + { + Extended_Cap_Type *e = t->ext; + int i, n = e->num_numeric; + + for (i = 0; i < n; i++) + { + if (strcmp (cap, e->numeric_capsi)) + continue; + return (*t->make_integer)(e->numeric_values + i*t->sizeof_number); + } + } + offset = compute_cap_offset (cap, t, Tgetnum_Map, t->num_numbers); if (offset < 0) return -1; @@ -469,6 +717,19 @@ if (t->flags == SLTERMCAP) return tcap_getflag (cap, t); + if (t->ext != NULL) + { + Extended_Cap_Type *e = t->ext; + int i, n = e->num_bool; + + for (i = 0; i < n; i++) + { + if (strcmp (cap, e->bool_capsi)) + continue; + return e->bool_valuesi; + } + } + offset = compute_cap_offset (cap, t, Tgetflag_Map, t->boolean_section_size); if (offset < 0) return -1;
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/sltime.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/sltime.c
Changed
@@ -1,6 +1,6 @@ /* time related system calls */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -360,8 +360,17 @@ { if (a->tm_year != b->tm_year) return a->tm_year - b->tm_year; +#if 1 + /* give tm_mon/tm_mday precedence over tm_yday */ + if (a->tm_mon != b->tm_mon) + return a->tm_mon - b->tm_mon; + if (a->tm_mday != b->tm_mday) + return a->tm_mday - b->tm_mday; +#else if (a->tm_yday != b->tm_yday) return a->tm_yday - b->tm_yday; +#endif + if (a->tm_hour - b->tm_hour) return a->tm_hour - b->tm_hour; return (a->tm_min - b->tm_min)*60 + (a->tm_sec - b->tm_sec);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/sltoken.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/sltoken.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -270,7 +270,7 @@ case FLOAT_TOKEN: case DOUBLE_TOKEN: case COMPLEX_TOKEN: - /* drop */ + /* fall through */ #endif default: if (NULL != (s = lookup_op_token_string (type))) @@ -844,12 +844,7 @@ is_binary = -1; break; } - if ((isunicode == 0) -#if 0 - && ((wch < 127) - || (utf8_encode == 0)) -#endif - ) + if (isunicode == 0) { if (wch == 0) is_binary = 1; @@ -1040,6 +1035,8 @@ if (ch == '\\') { + int cr = 0; + if (is_multiline_raw) { slen++ = ch; @@ -1048,15 +1045,23 @@ } ch = prep_get_char (); + if (ch == '\r') + { + cr = 1; + ch = prep_get_char (); + } + if ((ch == '\n') || (ch == 0)) { + /* ignore the \r, if present */ is_continued = 1; break; } slen++ = '\\'; if (len < maxlen) { - slen++ = ch; + if (cr) slen++ = '\r'; + if (len < maxlen) slen++ = ch; has_bs = 1; } continue; @@ -2277,7 +2282,7 @@ break; default: - SLang_verror (SL_Internal_Error, "Unsupported multline token: 0x%X", tok->type); + SLang_verror (SL_Internal_Error, "Unsupported multiline token: 0x%X", tok->type); return -1; }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/sltypes.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/sltypes.c
Changed
@@ -1,6 +1,6 @@ /* Basic type operations for S-Lang */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library. @@ -598,8 +598,8 @@ int SLang_assign_to_ref (SLang_Ref_Type *ref, SLtype type, VOID_STAR v) { - SLang_Object_Type *stkptr; SLang_Class_Type *cl; + int stack_depth; cl = _pSLclass_get_class (type); @@ -623,11 +623,11 @@ if (-1 == (*cl->cl_apush) (type, v)) return -1; - stkptr = _pSLang_get_run_stack_pointer (); + stack_depth = SLstack_depth (); if (0 == _pSLang_deref_assign (ref)) return 0; - if (stkptr != _pSLang_get_run_stack_pointer ()) + if (stack_depth != SLstack_depth ()) SLdo_pop (); return -1;
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slupper.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slupper.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slutf8.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slutf8.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slutty.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slutty.c
Changed
@@ -1,6 +1,6 @@ /* slutty.c --- Unix Low level terminal (tty) functions for S-Lang */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slvideo.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slvideo.c
Changed
@@ -1,6 +1,6 @@ /* -*- mode: C; mode: fold -*- */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slvmstty.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slvmstty.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slw32tty.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slw32tty.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slwclut.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slwclut.c
Changed
@@ -1,6 +1,6 @@ /* slwclut.c: wide character lookup tables */ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slwcwidth.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slwcwidth.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/slxstrng.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/slxstrng.c
Changed
@@ -1,5 +1,5 @@ /* -Copyright (C) 2004-2017,2018 John E. Davis +Copyright (C) 2004-2021,2022 John E. Davis This file is part of the S-Lang Library.
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/terminfo/aix4.inc -> _service:tar_scm:slang-2.3.3.tar.bz2/src/terminfo/aix4.inc
Changed
@@ -1,6 +1,6 @@ -/* This file was autogenerated using parsecaps.sl /tmp/Caps.aix4 */ +/* This file was autogenerated by parsecaps.sl */ -static Tgetstr_Map_Type Tgetstr_Map = +static Tgetstr_Map_Type Tgetstr_Map = { {"!1", 339 UNTIC_COMMENT("shifted save key")}, {"!2", 340 UNTIC_COMMENT("shifted suspend key")}, @@ -10,6 +10,7 @@ {"#3", 327 UNTIC_COMMENT("shifted insert-character key")}, {"#4", 328 UNTIC_COMMENT("shifted left-arrow key")}, {"%0", 304 UNTIC_COMMENT("redo key")}, + {"%1", 178 UNTIC_COMMENT("help key")}, {"%2", 296 UNTIC_COMMENT("mark key")}, {"%3", 297 UNTIC_COMMENT("message key")}, {"%4", 298 UNTIC_COMMENT("move key")}, @@ -52,8 +53,10 @@ {"@1", 288 UNTIC_COMMENT("begin key")}, {"@2", 289 UNTIC_COMMENT("cancel key")}, {"@3", 290 UNTIC_COMMENT("close key")}, + {"@4", 175 UNTIC_COMMENT("command-request key")}, {"@5", 291 UNTIC_COMMENT("copy key")}, {"@6", 292 UNTIC_COMMENT("create key")}, + {"@7", 177 UNTIC_COMMENT("end key")}, {"@8", 293 UNTIC_COMMENT("enter/send key")}, {"@9", 294 UNTIC_COMMENT("exit key")}, {"AB", 434 UNTIC_COMMENT("Set background color to #1, using ANSI escape")}, @@ -122,17 +125,17 @@ {"Fp", 267 UNTIC_COMMENT("F61 function key")}, {"Fq", 268 UNTIC_COMMENT("F62 function key")}, {"Fr", 269 UNTIC_COMMENT("F63 function key")}, - {"G1", 476 UNTIC_COMMENT("single upper right")}, - {"G2", 474 UNTIC_COMMENT("single upper left")}, - {"G3", 475 UNTIC_COMMENT("single lower left")}, - {"G4", 477 UNTIC_COMMENT("single lower right")}, - {"GC", 484 UNTIC_COMMENT("single intersection")}, - {"GD", 481 UNTIC_COMMENT("tee pointing down")}, - {"GH", 482 UNTIC_COMMENT("single horizontal line")}, - {"GL", 479 UNTIC_COMMENT("tee pointing left")}, - {"GR", 478 UNTIC_COMMENT("tee pointing right")}, - {"GU", 480 UNTIC_COMMENT("tee pointing up")}, - {"GV", 483 UNTIC_COMMENT("single vertical line")}, + {"G1", 469 UNTIC_COMMENT("single upper right")}, + {"G2", 467 UNTIC_COMMENT("single upper left")}, + {"G3", 468 UNTIC_COMMENT("single lower left")}, + {"G4", 470 UNTIC_COMMENT("single lower right")}, + {"GC", 477 UNTIC_COMMENT("single intersection")}, + {"GD", 474 UNTIC_COMMENT("tee pointing down")}, + {"GH", 475 UNTIC_COMMENT("single horizontal line")}, + {"GL", 472 UNTIC_COMMENT("tee pointing left")}, + {"GR", 471 UNTIC_COMMENT("tee pointing right")}, + {"GU", 473 UNTIC_COMMENT("tee pointing up")}, + {"GV", 476 UNTIC_COMMENT("single vertical line")}, {"Gm", 432 UNTIC_COMMENT("Curses should get button events, parameter #1 not documented.")}, {"HU", 353 UNTIC_COMMENT("hang-up phone")}, {"IC", 108 UNTIC_COMMENT("insert #1 characters (P*)")}, @@ -153,6 +156,10 @@ {"KY", 195 UNTIC_COMMENT("special mapped key 4 output")}, {"KZ", 197 UNTIC_COMMENT("special mapped key 5 output")}, {"Km", 429 UNTIC_COMMENT("Mouse event has occurred")}, + {"Kr", 199 UNTIC_COMMENT("special mapped key 6 input")}, + {"Ks", 201 UNTIC_COMMENT("special mapped key 7 input")}, + {"Kt", 203 UNTIC_COMMENT("special mapped key 8 input")}, + {"Ku", 205 UNTIC_COMMENT("special mapped key 9 input")}, {"Kv", 188 UNTIC_COMMENT("special mapped key 1 input")}, {"Kw", 190 UNTIC_COMMENT("special mapped key 2 input")}, {"Kx", 192 UNTIC_COMMENT("special mapped key 3 input")}, @@ -163,7 +170,7 @@ {"LO", 286 UNTIC_COMMENT("turn on soft labels")}, {"Lf", 347 UNTIC_COMMENT("label format")}, {"MC", 344 UNTIC_COMMENT("clear right and left soft margins")}, - {"ML", 345 UNTIC_COMMENT("set left soft margin at current column. See smgl. (ML is not in BSD termcap).")}, + {"ML", 345 UNTIC_COMMENT("set left soft margin at current column. (ML is not in BSD termcap).")}, {"ML", 442 UNTIC_COMMENT("Set both left and right margins to #1, #2. (ML is not in BSD termcap).")}, {"MR", 346 UNTIC_COMMENT("set right soft margin at current column")}, {"MT", 443 UNTIC_COMMENT("Sets both top and bottom margins to #1, #2")}, @@ -208,17 +215,12 @@ {"WG", 352 UNTIC_COMMENT("go to window #1")}, {"XF", 284 UNTIC_COMMENT("XOFF character")}, {"XN", 283 UNTIC_COMMENT("XON character")}, - {"Xh", 460 UNTIC_COMMENT("Enter horizontal highlight mode")}, - {"Xl", 461 UNTIC_COMMENT("Enter left highlight mode")}, - {"Xo", 462 UNTIC_COMMENT("Enter low highlight mode")}, - {"Xr", 463 UNTIC_COMMENT("Enter right highlight mode")}, - {"Xt", 464 UNTIC_COMMENT("Enter top highlight mode")}, - {"Xv", 465 UNTIC_COMMENT("Enter vertical highlight mode")}, {"Xy", 444 UNTIC_COMMENT("Repeat bit image cell #1 #2 times")}, + {"YI", 460 UNTIC_COMMENT("Set page length to #1 hundredth of an inch (some implementations use sL for termcap).")}, {"YZ", 451 UNTIC_COMMENT("Set page length to #1 lines")}, {"Yv", 446 UNTIC_COMMENT("Move to beginning of same row")}, {"Yw", 447 UNTIC_COMMENT("Give name for color #1")}, - {"Yx", 448 UNTIC_COMMENT("Define rectangualar bit image region")}, + {"Yx", 448 UNTIC_COMMENT("Define rectangular bit image region")}, {"Yy", 449 UNTIC_COMMENT("End a bit-image region")}, {"Yz", 450 UNTIC_COMMENT("Change to ribbon color #1")}, {"ZA", 378 UNTIC_COMMENT("Change number of characters per inch to #1")}, @@ -277,7 +279,7 @@ {"ae", 38 UNTIC_COMMENT("end alternate character set (P)")}, {"al", 53 UNTIC_COMMENT("insert line (P*)")}, {"as", 25 UNTIC_COMMENT("start alternate character set (P)")}, - {"bc", 471 UNTIC_COMMENT("move left, if not ^H")}, + {"bc", 464 UNTIC_COMMENT("move left, if not ^H")}, {"bl", 1 UNTIC_COMMENT("audible signal (bell) (P)")}, {"bm", 272 UNTIC_COMMENT("start bottom-line mode")}, {"bt", 0 UNTIC_COMMENT("back tab (P)")}, @@ -335,7 +337,7 @@ {"ho", 12 UNTIC_COMMENT("home cursor (if no cup)")}, {"hu", 137 UNTIC_COMMENT("half a line up")}, {"i1", 48 UNTIC_COMMENT("initialization string")}, - {"i2", 468 UNTIC_COMMENT("secondary initialization string")}, + {"i2", 461 UNTIC_COMMENT("secondary initialization string")}, {"i3", 50 UNTIC_COMMENT("initialization string")}, {"iP", 138 UNTIC_COMMENT("path name of program for initialization")}, {"ic", 52 UNTIC_COMMENT("insert character (P)")}, @@ -344,7 +346,6 @@ {"ip", 54 UNTIC_COMMENT("insert padding after inserted character")}, {"is", 49 UNTIC_COMMENT("initialization string")}, {"k0", 65 UNTIC_COMMENT("F0 function key")}, - {"k0", 173 UNTIC_COMMENT("backtab key")}, {"k1", 66 UNTIC_COMMENT("F1 function key")}, {"k2", 68 UNTIC_COMMENT("F2 function key")}, {"k3", 69 UNTIC_COMMENT("F3 function key")}, @@ -367,6 +368,7 @@ {"kL", 60 UNTIC_COMMENT("delete-line key")}, {"kM", 62 UNTIC_COMMENT("sent by rmir or smir in insert mode")}, {"kN", 81 UNTIC_COMMENT("next-page key")}, + {"kO", 173 UNTIC_COMMENT("backtab key")}, {"kP", 82 UNTIC_COMMENT("previous-page key")}, {"kQ", 183 UNTIC_COMMENT("quit key")}, {"kR", 85 UNTIC_COMMENT("scroll-backward key")}, @@ -379,25 +381,19 @@ {"ka", 56 UNTIC_COMMENT("clear-all-tabs key")}, {"kb", 55 UNTIC_COMMENT("backspace key")}, {"kd", 61 UNTIC_COMMENT("down-arrow key")}, - {"kd", 175 UNTIC_COMMENT("command-request key")}, {"ke", 88 UNTIC_COMMENT("leave 'keyboard_transmit' mode")}, {"kh", 76 UNTIC_COMMENT("home key")}, {"ki", 174 UNTIC_COMMENT("do request key")}, {"kl", 79 UNTIC_COMMENT("left-arrow key")}, + {"kn", 179 UNTIC_COMMENT("newline key")}, {"ko", 187 UNTIC_COMMENT("tab key")}, - {"ko", 472 UNTIC_COMMENT("list of self-mapped keycaps")}, + {"ko", 465 UNTIC_COMMENT("list of self-mapped keycaps")}, {"kp", 181 UNTIC_COMMENT("previous-command key")}, - {"kq", 178 UNTIC_COMMENT("help key")}, {"kr", 83 UNTIC_COMMENT("right-arrow key")}, - {"kr", 199 UNTIC_COMMENT("special mapped key 6 input")}, {"ks", 89 UNTIC_COMMENT("enter 'keyboard_transmit' mode")}, - {"ks", 201 UNTIC_COMMENT("special mapped key 7 input")}, {"kt", 58 UNTIC_COMMENT("clear-tab key")}, - {"kt", 203 UNTIC_COMMENT("special mapped key 8 input")}, {"ku", 87 UNTIC_COMMENT("up-arrow key")}, - {"ku", 205 UNTIC_COMMENT("special mapped key 9 input")}, {"kv", 180 UNTIC_COMMENT("next-pane key")}, - {"kw", 177 UNTIC_COMMENT("end key")}, {"kz", 185 UNTIC_COMMENT("scroll left")}, {"l0", 90 UNTIC_COMMENT("label on function key f0 if not f0")}, {"l1", 91 UNTIC_COMMENT("label on function key f1 if not f1")}, @@ -413,21 +409,20 @@ {"le", 14 UNTIC_COMMENT("move left one space")}, {"ll", 18 UNTIC_COMMENT("last line, first column (if no cup)")}, {"lv", 274 UNTIC_COMMENT("start left-vertical mode")}, - {"ma", 473 UNTIC_COMMENT("map arrow keys rogue(1) motion keys")}, + {"ma", 466 UNTIC_COMMENT("map motion-keys for vi version 2")}, {"mb", 26 UNTIC_COMMENT("turn on blinking")}, {"md", 27 UNTIC_COMMENT("turn on bold (extra bright) mode")}, {"me", 39 UNTIC_COMMENT("turn off all attributes")}, {"mh", 30 UNTIC_COMMENT("turn on half-bright mode")}, {"mk", 32 UNTIC_COMMENT("turn on blank mode (characters invisible)")}, - {"ml", 485 UNTIC_COMMENT("lock memory above cursor")}, + {"ml", 478 UNTIC_COMMENT("lock memory above cursor")}, {"mm", 102 UNTIC_COMMENT("turn on meta mode (8th-bit on)")}, {"mo", 101 UNTIC_COMMENT("turn off meta mode")}, {"mp", 33 UNTIC_COMMENT("turn on protected mode")}, {"mr", 34 UNTIC_COMMENT("turn on reverse video mode")}, - {"mu", 486 UNTIC_COMMENT("unlock memory")}, + {"mu", 479 UNTIC_COMMENT("unlock memory")}, {"nd", 17 UNTIC_COMMENT("non-destructive space (move right one space)")}, - {"nl", 179 UNTIC_COMMENT("newline key")}, - {"nl", 470 UNTIC_COMMENT("use to move down")}, + {"nl", 463 UNTIC_COMMENT("use to move down")}, {"nw", 103 UNTIC_COMMENT("newline (behave like cr followed by lf)")}, {"oc", 372 UNTIC_COMMENT("Set all color pairs to the original ones")}, {"op", 371 UNTIC_COMMENT("Set default pair to its original value")}, @@ -447,14 +442,12 @@ {"rc", 126 UNTIC_COMMENT("restore cursor to position of last save_cursor")}, {"rf", 125 UNTIC_COMMENT("name of reset file")}, {"rp", 121 UNTIC_COMMENT("repeat char #1 #2 times (P*)")}, - {"rs", 469 UNTIC_COMMENT("terminal reset string")}, + {"rs", 462 UNTIC_COMMENT("terminal reset string")}, {"rv", 273 UNTIC_COMMENT("start right-vertical mode")}, {"s0", 438 UNTIC_COMMENT("Shift to codeset 0 (EUC set 0, ASCII)")}, {"s1", 439 UNTIC_COMMENT("Shift to codeset 1")}, {"s2", 440 UNTIC_COMMENT("Shift to codeset 2")}, {"s3", 441 UNTIC_COMMENT("Shift to codeset 3")}, - {"sA", 466 UNTIC_COMMENT("Define second set of video attributes #1-#6")}, - {"sL", 467 UNTIC_COMMENT("YI Set page length to #1 hundredth of an inch")}, {"sa", 131 UNTIC_COMMENT("define video attributes #1-#9 (PG9)")}, {"sc", 128 UNTIC_COMMENT("save current cursor position (P)")}, {"se", 43 UNTIC_COMMENT("exit standout mode")}, @@ -492,11 +485,12 @@ {"", -1 UNTIC_COMMENT("NULL")}, }; -static Tgetstr_Map_Type Tgetnum_Map = + +static Tgetstr_Map_Type Tgetnum_Map = { {"BT", 30 UNTIC_COMMENT("number of buttons on mouse")}, {"Co", 13 UNTIC_COMMENT("maximum number of colors on screen")}, - {"MW", 12 UNTIC_COMMENT("maximum number of defineable windows")}, + {"MW", 12 UNTIC_COMMENT("maximum number of definable windows")}, {"NC", 15 UNTIC_COMMENT("video attributes that cannot be used with colors")}, {"Nl", 8 UNTIC_COMMENT("number of labels on screen")}, {"Ya", 16 UNTIC_COMMENT("numbers of bytes buffered before printing")}, @@ -536,7 +530,8 @@ {"", -1 UNTIC_COMMENT("NULL")}, }; -static Tgetstr_Map_Type Tgetflag_Map = + +static Tgetstr_Map_Type Tgetflag_Map = { {"5i", 22 UNTIC_COMMENT("printer will not echo on screen")}, {"HC", 23 UNTIC_COMMENT("cursor is hard to see")}, @@ -564,7 +559,7 @@ {"hc", 7 UNTIC_COMMENT("hardcopy terminal")}, {"hl", 29 UNTIC_COMMENT("terminal uses only HLS color notation (Tektronix)")}, {"hs", 9 UNTIC_COMMENT("has extra status line")}, - {"hz", 18 UNTIC_COMMENT("cannot print ~'s (hazeltine)")}, + {"hz", 18 UNTIC_COMMENT("cannot print ~'s (Hazeltine)")}, {"in", 10 UNTIC_COMMENT("insert mode distinguishes nulls")}, {"km", 8 UNTIC_COMMENT("Has a meta key (i.e., sets 8th-bit)")}, {"mi", 13 UNTIC_COMMENT("safe to move while in insert mode")}, @@ -585,3 +580,4 @@ {"", -1 UNTIC_COMMENT("NULL")}, }; +
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/terminfo/default.inc -> _service:tar_scm:slang-2.3.3.tar.bz2/src/terminfo/default.inc
Changed
@@ -1,6 +1,6 @@ -/* This file was autogenerated using parsecaps.sl /tmp/Caps */ +/* This file was autogenerated by parsecaps.sl */ -static Tgetstr_Map_Type Tgetstr_Map = +static Tgetstr_Map_Type Tgetstr_Map = { {"!1", 212 UNTIC_COMMENT("shifted save key")}, {"!2", 213 UNTIC_COMMENT("shifted suspend key")}, @@ -150,7 +150,7 @@ {"LO", 156 UNTIC_COMMENT("turn on soft labels")}, {"Lf", 273 UNTIC_COMMENT("label format")}, {"MC", 270 UNTIC_COMMENT("clear right and left soft margins")}, - {"ML", 271 UNTIC_COMMENT("set left soft margin at current column. See smgl. (ML is not in BSD termcap).")}, + {"ML", 271 UNTIC_COMMENT("set left soft margin at current column. (ML is not in BSD termcap).")}, {"ML", 368 UNTIC_COMMENT("Set both left and right margins to #1, #2. (ML is not in BSD termcap).")}, {"MR", 272 UNTIC_COMMENT("set right soft margin at current column")}, {"MT", 369 UNTIC_COMMENT("Sets both top and bottom margins to #1, #2")}, @@ -192,10 +192,11 @@ {"Xt", 390 UNTIC_COMMENT("Enter top highlight mode")}, {"Xv", 391 UNTIC_COMMENT("Enter vertical highlight mode")}, {"Xy", 370 UNTIC_COMMENT("Repeat bit image cell #1 #2 times")}, + {"YI", 393 UNTIC_COMMENT("Set page length to #1 hundredth of an inch (some implementations use sL for termcap).")}, {"YZ", 377 UNTIC_COMMENT("Set page length to #1 lines")}, {"Yv", 372 UNTIC_COMMENT("Move to beginning of same row")}, {"Yw", 373 UNTIC_COMMENT("Give name for color #1")}, - {"Yx", 374 UNTIC_COMMENT("Define rectangualar bit image region")}, + {"Yx", 374 UNTIC_COMMENT("Define rectangular bit image region")}, {"Yy", 375 UNTIC_COMMENT("End a bit-image region")}, {"Yz", 376 UNTIC_COMMENT("Change to ribbon color #1")}, {"ZA", 304 UNTIC_COMMENT("Change number of characters per inch to #1")}, @@ -344,7 +345,7 @@ {"la", 92 UNTIC_COMMENT("label on function key f10 if not f10")}, {"le", 14 UNTIC_COMMENT("move left one space")}, {"ll", 18 UNTIC_COMMENT("last line, first column (if no cup)")}, - {"ma", 399 UNTIC_COMMENT("map arrow keys rogue(1) motion keys")}, + {"ma", 399 UNTIC_COMMENT("map motion-keys for vi version 2")}, {"mb", 26 UNTIC_COMMENT("turn on blinking")}, {"md", 27 UNTIC_COMMENT("turn on bold (extra bright) mode")}, {"me", 39 UNTIC_COMMENT("turn off all attributes")}, @@ -383,7 +384,6 @@ {"s2", 366 UNTIC_COMMENT("Shift to codeset 2")}, {"s3", 367 UNTIC_COMMENT("Shift to codeset 3")}, {"sA", 392 UNTIC_COMMENT("Define second set of video attributes #1-#6")}, - {"sL", 393 UNTIC_COMMENT("YI Set page length to #1 hundredth of an inch")}, {"sa", 131 UNTIC_COMMENT("define video attributes #1-#9 (PG9)")}, {"sc", 128 UNTIC_COMMENT("save current cursor position (P)")}, {"se", 43 UNTIC_COMMENT("exit standout mode")}, @@ -419,11 +419,12 @@ {"", -1 UNTIC_COMMENT("NULL")}, }; -static Tgetstr_Map_Type Tgetnum_Map = + +static Tgetstr_Map_Type Tgetnum_Map = { {"BT", 30 UNTIC_COMMENT("number of buttons on mouse")}, {"Co", 13 UNTIC_COMMENT("maximum number of colors on screen")}, - {"MW", 12 UNTIC_COMMENT("maximum number of defineable windows")}, + {"MW", 12 UNTIC_COMMENT("maximum number of definable windows")}, {"NC", 15 UNTIC_COMMENT("video attributes that cannot be used with colors")}, {"Nl", 8 UNTIC_COMMENT("number of labels on screen")}, {"Ya", 16 UNTIC_COMMENT("numbers of bytes buffered before printing")}, @@ -463,7 +464,8 @@ {"", -1 UNTIC_COMMENT("NULL")}, }; -static Tgetstr_Map_Type Tgetflag_Map = + +static Tgetstr_Map_Type Tgetflag_Map = { {"5i", 22 UNTIC_COMMENT("printer will not echo on screen")}, {"HC", 23 UNTIC_COMMENT("cursor is hard to see")}, @@ -491,7 +493,7 @@ {"hc", 7 UNTIC_COMMENT("hardcopy terminal")}, {"hl", 29 UNTIC_COMMENT("terminal uses only HLS color notation (Tektronix)")}, {"hs", 9 UNTIC_COMMENT("has extra status line")}, - {"hz", 18 UNTIC_COMMENT("cannot print ~'s (hazeltine)")}, + {"hz", 18 UNTIC_COMMENT("cannot print ~'s (Hazeltine)")}, {"in", 10 UNTIC_COMMENT("insert mode distinguishes nulls")}, {"km", 8 UNTIC_COMMENT("Has a meta key (i.e., sets 8th-bit)")}, {"mi", 13 UNTIC_COMMENT("safe to move while in insert mode")}, @@ -512,3 +514,4 @@ {"", -1 UNTIC_COMMENT("NULL")}, }; +
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/terminfo/hpux11.inc -> _service:tar_scm:slang-2.3.3.tar.bz2/src/terminfo/hpux11.inc
Changed
@@ -1,6 +1,6 @@ -/* This file was autogenerated using parsecaps.sl /tmp/Caps.hpux11 */ +/* This file was autogenerated by parsecaps.sl */ -static Tgetstr_Map_Type Tgetstr_Map = +static Tgetstr_Map_Type Tgetstr_Map = { {"!1", 267 UNTIC_COMMENT("shifted save key")}, {"!2", 268 UNTIC_COMMENT("shifted suspend key")}, @@ -150,14 +150,27 @@ {"LO", 148 UNTIC_COMMENT("turn on soft labels")}, {"Lf", 275 UNTIC_COMMENT("label format")}, {"MC", 272 UNTIC_COMMENT("clear right and left soft margins")}, - {"ML", 273 UNTIC_COMMENT("set left soft margin at current column. See smgl. (ML is not in BSD termcap).")}, + {"ML", 273 UNTIC_COMMENT("set left soft margin at current column. (ML is not in BSD termcap).")}, {"ML", 370 UNTIC_COMMENT("Set both left and right margins to #1, #2. (ML is not in BSD termcap).")}, {"MR", 274 UNTIC_COMMENT("set right soft margin at current column")}, {"MT", 371 UNTIC_COMMENT("Sets both top and bottom margins to #1, #2")}, {"Mi", 358 UNTIC_COMMENT("Mouse status information")}, {"PA", 287 UNTIC_COMMENT("pause for 2-3 seconds")}, {"PU", 285 UNTIC_COMMENT("select pulse dialing")}, + {"Q1", 389 UNTIC_COMMENT("Enter horizontal highlight mode")}, + {"Q2", 390 UNTIC_COMMENT("Enter left highlight mode")}, + {"Q3", 391 UNTIC_COMMENT("Enter low highlight mode")}, + {"Q4", 392 UNTIC_COMMENT("Enter right highlight mode")}, + {"Q5", 393 UNTIC_COMMENT("Enter top highlight mode")}, + {"Q6", 394 UNTIC_COMMENT("Enter vertical highlight mode")}, + {"Q7", 395 UNTIC_COMMENT("Define second set of video attributes #1-#6")}, + {"Q8", 396 UNTIC_COMMENT("Exit horizontal highlight mode")}, + {"Q9", 397 UNTIC_COMMENT("Exit left highlight mode")}, {"QD", 283 UNTIC_COMMENT("dial number #1 without checking")}, + {"Qa", 398 UNTIC_COMMENT("Exit low highlight mode")}, + {"Qb", 399 UNTIC_COMMENT("Exit right highlight mode")}, + {"Qc", 400 UNTIC_COMMENT("Exit top highlight mode")}, + {"Qd", 401 UNTIC_COMMENT("Exit vertical highlight mode")}, {"RA", 209 UNTIC_COMMENT("turn off automatic margins")}, {"RC", 278 UNTIC_COMMENT("remove clock")}, {"RF", 270 UNTIC_COMMENT("send next input char (for ptys)")}, @@ -184,24 +197,13 @@ {"WA", 288 UNTIC_COMMENT("wait for dial-tone")}, {"WG", 280 UNTIC_COMMENT("go to window #1")}, {"XF", 211 UNTIC_COMMENT("XOFF character")}, - {"XH", 396 UNTIC_COMMENT("Exit horizontal highlight mode")}, - {"XL", 397 UNTIC_COMMENT("Exit left highlight mode")}, {"XN", 210 UNTIC_COMMENT("XON character")}, - {"XO", 398 UNTIC_COMMENT("Exit low highlight mode")}, - {"XR", 399 UNTIC_COMMENT("Exit right highlight mode")}, - {"XT", 400 UNTIC_COMMENT("Exit top highlight mode")}, - {"XV", 401 UNTIC_COMMENT("Exit vertical highlight mode")}, - {"Xh", 389 UNTIC_COMMENT("Enter horizontal highlight mode")}, - {"Xl", 390 UNTIC_COMMENT("Enter left highlight mode")}, - {"Xo", 391 UNTIC_COMMENT("Enter low highlight mode")}, - {"Xr", 392 UNTIC_COMMENT("Enter right highlight mode")}, - {"Xt", 393 UNTIC_COMMENT("Enter top highlight mode")}, - {"Xv", 394 UNTIC_COMMENT("Enter vertical highlight mode")}, {"Xy", 372 UNTIC_COMMENT("Repeat bit image cell #1 #2 times")}, + {"YI", 388 UNTIC_COMMENT("Set page length to #1 hundredth of an inch (some implementations use sL for termcap).")}, {"YZ", 379 UNTIC_COMMENT("Set page length to #1 lines")}, {"Yv", 374 UNTIC_COMMENT("Move to beginning of same row")}, {"Yw", 375 UNTIC_COMMENT("Give name for color #1")}, - {"Yx", 376 UNTIC_COMMENT("Define rectangualar bit image region")}, + {"Yx", 376 UNTIC_COMMENT("Define rectangular bit image region")}, {"Yy", 377 UNTIC_COMMENT("End a bit-image region")}, {"Yz", 378 UNTIC_COMMENT("Change to ribbon color #1")}, {"ZA", 306 UNTIC_COMMENT("Change number of characters per inch to #1")}, @@ -350,7 +352,7 @@ {"la", 92 UNTIC_COMMENT("label on function key f10 if not f10")}, {"le", 14 UNTIC_COMMENT("move left one space")}, {"ll", 18 UNTIC_COMMENT("last line, first column (if no cup)")}, - {"ma", 407 UNTIC_COMMENT("map arrow keys rogue(1) motion keys")}, + {"ma", 407 UNTIC_COMMENT("map motion-keys for vi version 2")}, {"mb", 26 UNTIC_COMMENT("turn on blinking")}, {"md", 27 UNTIC_COMMENT("turn on bold (extra bright) mode")}, {"me", 39 UNTIC_COMMENT("turn off all attributes")}, @@ -388,8 +390,6 @@ {"s1", 367 UNTIC_COMMENT("Shift to codeset 1")}, {"s2", 368 UNTIC_COMMENT("Shift to codeset 2")}, {"s3", 369 UNTIC_COMMENT("Shift to codeset 3")}, - {"sA", 395 UNTIC_COMMENT("Define second set of video attributes #1-#6")}, - {"sL", 388 UNTIC_COMMENT("YI Set page length to #1 hundredth of an inch")}, {"sa", 131 UNTIC_COMMENT("define video attributes #1-#9 (PG9)")}, {"sc", 128 UNTIC_COMMENT("save current cursor position (P)")}, {"se", 43 UNTIC_COMMENT("exit standout mode")}, @@ -425,11 +425,12 @@ {"", -1 UNTIC_COMMENT("NULL")}, }; -static Tgetstr_Map_Type Tgetnum_Map = + +static Tgetstr_Map_Type Tgetnum_Map = { {"BT", 30 UNTIC_COMMENT("number of buttons on mouse")}, {"Co", 13 UNTIC_COMMENT("maximum number of colors on screen")}, - {"MW", 12 UNTIC_COMMENT("maximum number of defineable windows")}, + {"MW", 12 UNTIC_COMMENT("maximum number of definable windows")}, {"NC", 15 UNTIC_COMMENT("video attributes that cannot be used with colors")}, {"Nl", 8 UNTIC_COMMENT("number of labels on screen")}, {"Ya", 16 UNTIC_COMMENT("numbers of bytes buffered before printing")}, @@ -469,7 +470,8 @@ {"", -1 UNTIC_COMMENT("NULL")}, }; -static Tgetstr_Map_Type Tgetflag_Map = + +static Tgetstr_Map_Type Tgetflag_Map = { {"5i", 22 UNTIC_COMMENT("printer will not echo on screen")}, {"HC", 23 UNTIC_COMMENT("cursor is hard to see")}, @@ -497,7 +499,7 @@ {"hc", 7 UNTIC_COMMENT("hardcopy terminal")}, {"hl", 29 UNTIC_COMMENT("terminal uses only HLS color notation (Tektronix)")}, {"hs", 9 UNTIC_COMMENT("has extra status line")}, - {"hz", 18 UNTIC_COMMENT("cannot print ~'s (hazeltine)")}, + {"hz", 18 UNTIC_COMMENT("cannot print ~'s (Hazeltine)")}, {"in", 10 UNTIC_COMMENT("insert mode distinguishes nulls")}, {"km", 8 UNTIC_COMMENT("Has a meta key (i.e., sets 8th-bit)")}, {"mi", 13 UNTIC_COMMENT("safe to move while in insert mode")}, @@ -518,3 +520,4 @@ {"", -1 UNTIC_COMMENT("NULL")}, }; +
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/terminfo/osf1r5.inc -> _service:tar_scm:slang-2.3.3.tar.bz2/src/terminfo/osf1r5.inc
Changed
@@ -1,6 +1,6 @@ -/* This file was autogenerated using parsecaps.sl /tmp/Caps.osf1r5 */ +/* This file was autogenerated by parsecaps.sl */ -static Tgetstr_Map_Type Tgetstr_Map = +static Tgetstr_Map_Type Tgetstr_Map = { {"!1", 379 UNTIC_COMMENT("shifted save key")}, {"!2", 380 UNTIC_COMMENT("shifted suspend key")}, @@ -169,7 +169,7 @@ {"LO", 386 UNTIC_COMMENT("turn on soft labels")}, {"Lf", 384 UNTIC_COMMENT("label format")}, {"MC", 255 UNTIC_COMMENT("clear right and left soft margins")}, - {"ML", 424 UNTIC_COMMENT("set left soft margin at current column. See smgl. (ML is not in BSD termcap).")}, + {"ML", 424 UNTIC_COMMENT("set left soft margin at current column. (ML is not in BSD termcap).")}, {"ML", 426 UNTIC_COMMENT("Set both left and right margins to #1, #2. (ML is not in BSD termcap).")}, {"MR", 428 UNTIC_COMMENT("set right soft margin at current column")}, {"MT", 430 UNTIC_COMMENT("Sets both top and bottom margins to #1, #2")}, @@ -221,10 +221,11 @@ {"Xt", 460 UNTIC_COMMENT("Enter top highlight mode")}, {"Xv", 461 UNTIC_COMMENT("Enter vertical highlight mode")}, {"Xy", 246 UNTIC_COMMENT("Repeat bit image cell #1 #2 times")}, + {"YI", 455 UNTIC_COMMENT("Set page length to #1 hundredth of an inch (some implementations use sL for termcap).")}, {"YZ", 427 UNTIC_COMMENT("Set page length to #1 lines")}, {"Yv", 248 UNTIC_COMMENT("Move to beginning of same row")}, {"Yw", 258 UNTIC_COMMENT("Give name for color #1")}, - {"Yx", 260 UNTIC_COMMENT("Define rectangualar bit image region")}, + {"Yx", 260 UNTIC_COMMENT("Define rectangular bit image region")}, {"Yy", 267 UNTIC_COMMENT("End a bit-image region")}, {"Yz", 421 UNTIC_COMMENT("Change to ribbon color #1")}, {"ZA", 249 UNTIC_COMMENT("Change number of characters per inch to #1")}, @@ -410,7 +411,7 @@ {"la", 92 UNTIC_COMMENT("label on function key f10 if not f10")}, {"le", 14 UNTIC_COMMENT("move left one space")}, {"ll", 18 UNTIC_COMMENT("last line, first column (if no cup)")}, - {"ma", 468 UNTIC_COMMENT("map arrow keys rogue(1) motion keys")}, + {"ma", 468 UNTIC_COMMENT("map motion-keys for vi version 2")}, {"mb", 26 UNTIC_COMMENT("turn on blinking")}, {"md", 27 UNTIC_COMMENT("turn on bold (extra bright) mode")}, {"me", 39 UNTIC_COMMENT("turn off all attributes")}, @@ -450,7 +451,6 @@ {"s2", 413 UNTIC_COMMENT("Shift to codeset 2")}, {"s3", 414 UNTIC_COMMENT("Shift to codeset 3")}, {"sA", 462 UNTIC_COMMENT("Define second set of video attributes #1-#6")}, - {"sL", 455 UNTIC_COMMENT("YI Set page length to #1 hundredth of an inch")}, {"sa", 131 UNTIC_COMMENT("define video attributes #1-#9 (PG9)")}, {"sc", 128 UNTIC_COMMENT("save current cursor position (P)")}, {"se", 43 UNTIC_COMMENT("exit standout mode")}, @@ -487,11 +487,12 @@ {"", -1 UNTIC_COMMENT("NULL")}, }; -static Tgetstr_Map_Type Tgetnum_Map = + +static Tgetstr_Map_Type Tgetnum_Map = { {"BT", 11 UNTIC_COMMENT("number of buttons on mouse")}, {"Co", 17 UNTIC_COMMENT("maximum number of colors on screen")}, - {"MW", 21 UNTIC_COMMENT("maximum number of defineable windows")}, + {"MW", 21 UNTIC_COMMENT("maximum number of definable windows")}, {"NC", 24 UNTIC_COMMENT("video attributes that can not be used with colors")}, {"Nl", 26 UNTIC_COMMENT("number of labels on screen")}, {"Ya", 10 UNTIC_COMMENT("numbers of bytes buffered before printing")}, @@ -531,7 +532,8 @@ {"", -1 UNTIC_COMMENT("NULL")}, }; -static Tgetstr_Map_Type Tgetflag_Map = + +static Tgetstr_Map_Type Tgetflag_Map = { {"5i", 34 UNTIC_COMMENT("printer will not echo on screen")}, {"HC", 26 UNTIC_COMMENT("cursor is hard to see")}, @@ -559,7 +561,7 @@ {"hc", 7 UNTIC_COMMENT("hardcopy terminal")}, {"hl", 28 UNTIC_COMMENT("terminal uses only HLS color notation (Tektronix)")}, {"hs", 9 UNTIC_COMMENT("has extra status line")}, - {"hz", 18 UNTIC_COMMENT("cannot print ~'s (hazeltine)")}, + {"hz", 18 UNTIC_COMMENT("cannot print ~'s (Hazeltine)")}, {"in", 10 UNTIC_COMMENT("insert mode distinguishes nulls")}, {"km", 8 UNTIC_COMMENT("Has a meta key (i.e., sets 8th-bit)")}, {"mi", 13 UNTIC_COMMENT("safe to move while in insert mode")}, @@ -580,3 +582,4 @@ {"", -1 UNTIC_COMMENT("NULL")}, }; +
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/terminfo/parsecaps.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/terminfo/parsecaps.sl
Changed
@@ -71,8 +71,7 @@ variable s = read_caps_file (__argv1); variable fp = stdout; - () = fprintf (stdout, "/* This file was autogenerated using %s */\n\n", - strjoin (__argv, " ")); + () = fprintf (stdout, "/* This file was autogenerated by parsecaps.sl */\n\n"); write_table (fp, s, "str", "Tgetstr_Map"); write_table (fp, s, "num", "Tgetnum_Map");
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/terminfo/uwin.inc -> _service:tar_scm:slang-2.3.3.tar.bz2/src/terminfo/uwin.inc
Changed
@@ -1,6 +1,6 @@ -/* This file was autogenerated using parsecaps.sl /tmp/Caps.uwin */ +/* This file was autogenerated by parsecaps.sl */ -static Tgetstr_Map_Type Tgetstr_Map = +static Tgetstr_Map_Type Tgetstr_Map = { {"!1", 212 UNTIC_COMMENT("shifted save key")}, {"!2", 213 UNTIC_COMMENT("shifted suspend key")}, @@ -145,7 +145,7 @@ {"LF", 157 UNTIC_COMMENT("turn off soft labels")}, {"LO", 156 UNTIC_COMMENT("turn on soft labels")}, {"MC", 270 UNTIC_COMMENT("clear right and left soft margins")}, - {"ML", 271 UNTIC_COMMENT("set left soft margin at current column. See smgl. (ML is not in BSD termcap).")}, + {"ML", 271 UNTIC_COMMENT("set left soft margin at current column. (ML is not in BSD termcap).")}, {"MR", 272 UNTIC_COMMENT("set right soft margin at current column")}, {"Mi", 280 UNTIC_COMMENT("Mouse status information")}, {"RA", 152 UNTIC_COMMENT("turn off automatic margins")}, @@ -257,7 +257,7 @@ {"la", 92 UNTIC_COMMENT("label on function key f10 if not f10")}, {"le", 14 UNTIC_COMMENT("move left one space")}, {"ll", 18 UNTIC_COMMENT("last line, first column (if no cup)")}, - {"ma", 299 UNTIC_COMMENT("map arrow keys rogue(1) motion keys")}, + {"ma", 299 UNTIC_COMMENT("map motion-keys for vi version 2")}, {"mb", 26 UNTIC_COMMENT("turn on blinking")}, {"md", 27 UNTIC_COMMENT("turn on bold (extra bright) mode")}, {"me", 39 UNTIC_COMMENT("turn off all attributes")}, @@ -319,7 +319,8 @@ {"", -1 UNTIC_COMMENT("NULL")}, }; -static Tgetstr_Map_Type Tgetnum_Map = + +static Tgetstr_Map_Type Tgetnum_Map = { {"BT", 11 UNTIC_COMMENT("number of buttons on mouse")}, {"Co", 12 UNTIC_COMMENT("maximum number of colors on screen")}, @@ -345,7 +346,8 @@ {"", -1 UNTIC_COMMENT("NULL")}, }; -static Tgetstr_Map_Type Tgetflag_Map = + +static Tgetstr_Map_Type Tgetflag_Map = { {"5i", 22 UNTIC_COMMENT("printer will not echo on screen")}, {"HC", 23 UNTIC_COMMENT("cursor is hard to see")}, @@ -366,7 +368,7 @@ {"hc", 7 UNTIC_COMMENT("hardcopy terminal")}, {"hl", 29 UNTIC_COMMENT("terminal uses only HLS color notation (Tektronix)")}, {"hs", 9 UNTIC_COMMENT("has extra status line")}, - {"hz", 18 UNTIC_COMMENT("cannot print ~'s (hazeltine)")}, + {"hz", 18 UNTIC_COMMENT("cannot print ~'s (Hazeltine)")}, {"in", 10 UNTIC_COMMENT("insert mode distinguishes nulls")}, {"km", 8 UNTIC_COMMENT("Has a meta key (i.e., sets 8th-bit)")}, {"mi", 13 UNTIC_COMMENT("safe to move while in insert mode")}, @@ -387,3 +389,4 @@ {"", -1 UNTIC_COMMENT("NULL")}, }; +
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/array.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/array.sl
Changed
@@ -371,86 +371,99 @@ failed ("Binary operation `%s' failed", op); } -check_result (1,2 + 3,4, 4,6,"+"); -check_result (1 + 3,4, 4,5,"+"); -check_result (3,4 + 1, 4,5,"+"); +private define check_bin_result (a, op, b, ans, opstr) +{ + variable types = Char_Type, UChar_Type, Short_Type, UShort_Type, + Int_Type, UInt_Type, Long_Type, ULong_Type; + + variable atype, btype; + foreach atype (types) + { + variable aa = typecast (a, atype); + foreach btype (types) + { + variable bb = typecast (b, btype); + check_result ((@op)(aa, bb), ans, "$atype $opstr $btype"$); + } + } +} -check_result (1,2 - 3,4, -2,-2,"-"); -check_result (1 - 3,4, -2,-3,"-"); -check_result (3,4 - 1, 2,3,"-"); +check_bin_result (1,2, &_op_plus, 3,4, 4,6,"+"); +check_bin_result (1, &_op_plus, 3,4, 4,5,"+"); +check_bin_result (3,4, &_op_plus, 1, 4,5,"+"); -check_result (1,2 * 3,4, 3,8, "*"); -check_result (1 * 3,4, 3,4, "*"); -check_result (3,4 * 1, 3,4, "*"); +check_bin_result (1,2, &_op_minus, 3,4, -2,-2,"-"); +check_bin_result (1, &_op_minus, 3,4, -2,-3,"-"); +check_bin_result (3,4, &_op_minus, 1, 2,3,"-"); -check_result (12,24 / 3,4, 4,6,"/"); -check_result (12 / 3,4, 4,3,"/"); -check_result (3,4 / 1, 3,4,"/"); +check_bin_result (1,2, &_op_times, 3,4, 3,8, "*"); +check_bin_result (1, &_op_times, 3,4, 3,4, "*"); +check_bin_result (3,4, &_op_times, 1, 3,4, "*"); -check_result (1,2 mod 3,4, 1,2,"mod"); -check_result (3 mod 3,2, 0,1,"mod"); -check_result (3,4 mod 4, 3,0,"mod"); +check_bin_result (12,24, &_op_divide, 3,4, 4,6,"/"); +check_bin_result (12, &_op_divide, 3,4, 4,3,"/"); +check_bin_result (3,4, &_op_divide, 1, 3,4,"/"); -check_result (1,2 == 3,2, 0,1,"=="); -check_result (3 == 3,4, 1,0,"=="); -check_result (3,4 == 1, 0,0,"=="); +check_bin_result (1,2, &_op_mod, 3,4, 1,2,"mod"); +check_bin_result (3, &_op_mod, 3,2, 0,1,"mod"); +check_bin_result (3,4, &_op_mod, 4, 3,0,"mod"); -check_result (1,2 != 3,2, 1,0,"!="); -check_result (3 != 3,4, 0,1,"!="); -check_result (3,4 != 1, 1,1,"!="); +check_bin_result (1,2, &_op_eqs, 3,2, 0,1,"=="); +check_bin_result (3, &_op_eqs, 3,4, 1,0,"=="); +check_bin_result (3,4, &_op_eqs, 1, 0,0,"=="); -check_result (1,2 > 3,2, 0,0,">"); -check_result (1 > 3,4, 0,0,">"); -check_result (3,4 > 1, 1,1,">"); +check_bin_result (1,2, &_op_neqs, 3,2, 1,0,"!="); +check_bin_result (3, &_op_neqs, 3,4, 0,1,"!="); +check_bin_result (3,4, &_op_neqs, 1, 1,1,"!="); -check_result (1,2 >= 3,2, 0,1,">="); -check_result (1 >= 3,4, 0,0,">="); -check_result (3,4 >= 1, 1,1,">="); +check_bin_result (1,2, &_op_gt, 3,2, 0,0,">"); +check_bin_result (1, &_op_gt, 3,4, 0,0,">"); +check_bin_result (3,4, &_op_gt, 1, 1,1,">"); -check_result (1,2 >= 3,2, 0,1,">="); -check_result (1 >= 3,4, 0,0,">="); -check_result (3,4 >= 1, 1,1,">="); +check_bin_result (1,2, &_op_ge, 3,2, 0,1,">="); +check_bin_result (1, &_op_ge, 3,4, 0,0,">="); +check_bin_result (3,4, &_op_ge, 1, 1,1,">="); -check_result (1,2 < 3,2, 1,0,"<"); -check_result (1 < 3,4, 1,1,"<"); -check_result (3,4 < 1, 0,0,"<"); +check_bin_result (1,2, &_op_lt, 3,2, 1,0,"<"); +check_bin_result (1, &_op_lt, 3,4, 1,1,"<"); +check_bin_result (3,4, &_op_lt, 1, 0,0,"<"); -check_result (1,2 <= 3,2, 1,1,"<="); -check_result (1 <= 3,4, 1,1,"<="); -check_result (3,4 <= 1, 0,0,"<="); +check_bin_result (1,2, &_op_le, 3,2, 1,1,"<="); +check_bin_result (1, &_op_le, 3,4, 1,1,"<="); +check_bin_result (3,4, &_op_le, 1, 0,0,"<="); #ifexists Double_Type -check_result (1,2 ^ 3,2, 1,4,"^"); -check_result (1 ^ 3,4, 1,1,"^"); -check_result (3,4 ^ 1, 3,4,"^"); -check_result (3,4 ^ 0, 1,1,"^"); +check_bin_result (1,2, &_op_pow, 3,2, 1,4,"^"); +check_bin_result (1, &_op_pow, 3,4, 1,1,"^"); +check_bin_result (3,4, &_op_pow, 1, 3,4,"^"); +check_bin_result (3,4, &_op_pow, 0, 1,1,"^"); #endif -check_result (1,2 or 3,2, 1,1,"or"); -check_result (1 or 3,4, 1,1,"or"); -check_result (0,1 or 1, 1,1,"or"); +check_bin_result (1,2, &_op_or, 3,2, 1,1,"or"); +check_bin_result (1, &_op_or, 3,4, 1,1,"or"); +check_bin_result (0,1, &_op_or, 1, 1,1,"or"); -check_result (1,2 and 3,2, 1,1,"and"); -check_result (1 and 0,4, 0,1,"and"); -check_result (3,4 and 0, 0,0,"and"); +check_bin_result (1,2, &_op_and, 3,2, 1,1,"and"); +check_bin_result (1, &_op_and, 0,4, 0,1,"and"); +check_bin_result (3,4, &_op_and, 0, 0,0,"and"); -check_result (1,2 & 3,2, 1,2,"&"); -check_result (1 & 3,4, 1,0,"&"); -check_result (3,4 & 1, 1,0,"&"); +check_bin_result (1,2, &_op_band, 3,2, 1,2,"&"); +check_bin_result (1, &_op_band, 3,4, 1,0,"&"); +check_bin_result (3,4, &_op_band, 1, 1,0,"&"); -check_result (1,2 | 3,2, 3,2,"|"); -check_result (1 | 3,4, 3,5,"|"); -check_result (3,4 | 1, 3,5,"|"); +check_bin_result (1,2, &_op_bor, 3,2, 3,2,"|"); +check_bin_result (1, &_op_bor, 3,4, 3,5,"|"); +check_bin_result (3,4, &_op_bor, 1, 3,5,"|"); -check_result (1,2 xor 3,2, 2,0,"xor"); -check_result (1 xor 3,4, 2,5,"xor"); -check_result (3,4 xor 1, 2,5,"xor"); +check_bin_result (1,2, &_op_xor, 3,2, 2,0,"xor"); +check_bin_result (1, &_op_xor, 3,4, 2,5,"xor"); +check_bin_result (3,4, &_op_xor, 1, 2,5,"xor"); -check_result (1,2 shl 3,2, 8,8,"shl"); -check_result (1 shl 3,4, 8,16,"shl"); -check_result (3,4 shl 1, 6,8,"shl"); +check_bin_result (1,2, &_op_shl, 3,2, 8,8,"shl"); +check_bin_result (1, &_op_shl, 3,4, 8,16,"shl"); +check_bin_result (3,4, &_op_shl, 1, 6,8,"shl"); -check_result (1,4 shr 3,1, 0,2,"shr"); -check_result (8 shr 3,4, 1,0,"shr"); -check_result (3,4 shr 1, 1,2,"shr"); +check_bin_result (1,4, &_op_shr, 3,1, 0,2,"shr"); +check_bin_result (8, &_op_shr, 3,4, 1,0,"shr"); +check_bin_result (3,4, &_op_shr, 1, 1,2,"shr"); % Test __tmp optimizations private define test_tmp () @@ -732,9 +745,12 @@ test_sum (A,1); test_sum (A,0); +#ifexists Complex_Type A = 1+2i, 2+3i, 3+4i; if (sum(A) != A0 + A1 + A2) failed ("sum(Complex)"); +#endif + #endif % Double_Type define find_min (a) @@ -1449,7 +1465,9 @@ test_array_types (1h, 1L); test_array_types (1h, 1f); test_array_types (1h, 1.0); +#ifexists Complex_Type test_array_types (1h, 1j); +#endif test_array_types ("a", "a\0"); % Test presence of NULLs in inline arrays @@ -1659,9 +1677,11 @@ variable s, t; s = sumsq (a); +#ifexists Complex_Type if (_typeof (a) == Complex_Type) t = sumsq (Real(a)) + sumsq(Imag(a)); else +#endif t = sum (a*a); if (s != t) @@ -1915,6 +1935,57 @@ test_init_char_array ("HelloWorld"); test_init_char_array ("\xAB\xCD\xEF"); +private define check_indices (a, idx, ans) +{ + variable b; + try + { + b = aidx; + if (ans == NULL) failed ("get: Bad index not detected"); + } + catch IndexError: + { + if (ans != NULL) failed ("get: Bad index exception erroneously caught"); + } + if ((ans != NULL) + && (not _eqs (ans, b))) + { + failed ("check_indices: Unexpected result: %S != %S", b, ans); + } + + b = @a; + try + { + bidx = aidx; + if (ans == NULL) failed ("put: Bad index not detected"); + } + catch IndexError: + { + if (ans != NULL) failed ("put: Bad index exception erroneously caught"); + } +} +check_indices (1,2,3, 0:2, 1,2,3); +check_indices (1,2,3, :2, 1,2,3); +check_indices (1,2,3, :3, NULL); +check_indices (1,2,3, :-2, 1,2); +check_indices (1,2,3, :-3, 1); +check_indices (1,2,3, :-4, Int_Type0); +check_indices (1,2,3, :-5, Int_Type0); +check_indices (1,2,3, -1:, 3); +check_indices (1,2,3, -3:, 1,2,3); +check_indices (1,2,3, -4:, NULL); +check_indices (1,2,3, :3:-1, Int_Type0); +check_indices (1,2,3, ::-1, 3,2,1); + +check_indices (1,2,3, -1::-1, 3,2,1); +check_indices (1,2,3, 0:3, NULL); +check_indices (1,2,3, 0,3, NULL); +check_indices (1,2,3, -4,-2,-1, NULL); +check_indices (1,2,3, 2:-3, Int_Type0); +check_indices ("foo", "bar", "baz", 0:3, NULL); +check_indices ("foo", "bar", "baz", 0,3, NULL); +check_indices ("foo", "bar", "baz", -4,-2,-1, NULL); +check_indices ("foo", "bar", "baz", 2:-3, String_Type0); print ("Ok\n"); exit (0);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/assoc.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/assoc.sl
Changed
@@ -207,7 +207,9 @@ { "foo", 1, "bar", PI, +#ifexists Complex_Type "complex", 2+3i, +#endif "string", "foobar", "array", 1,2,3,4, "struct", struct {foo, bar}, @@ -224,7 +226,9 @@ { "foo", "1", "bar", "3.141592653589793", +#ifexists Complex_Type "complex", "(2 + 3i)", +#endif "string", "foobar", "array", "Integer_Type4", "struct", "Struct_Type with 2 fields",
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/eqs.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/eqs.sl
Changed
@@ -5,8 +5,10 @@ if (0 == _eqs (1h, 1L)) failed ("_eqs(1h,1L)"); +#ifexists Complex_Type if (0 == _eqs (1h, 1+0i)) failed ("_eqs(1h,1+0i)"); +#endif if (0 == _eqs (1h:10h, 1L:10L)) failed ("_eqs (arrays of ints)");
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/list.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/list.sl
Changed
@@ -279,7 +279,10 @@ private define test_api_list () { variable list = {"string", 10, - PI, 3i, + PI, +#ifexists Complex_Type + 3i, +#endif &failed, 1:10, Struct_Type12, Assoc_Type}; variable clist = api_create_list (__push_list (list)); @@ -306,7 +309,11 @@ private define test_api_pop_and_push_list () { - variable l1 = { 1, PI, 2+3i, "foobar", 1,2,3,4, struct {foo, bar}, Assoc_TypeInteger_Type, 42 }; + variable l1 = { 1, PI, +#ifexists Complex_Type + 2+3i, +#endif + "foobar", 1,2,3,4, struct {foo, bar}, Assoc_TypeInteger_Type, 42 }; l1; variable l2 = api_pop_and_push_list (); ifnot (__is_same (l1, l2))
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/math.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/math.sl
Changed
@@ -341,11 +341,11 @@ if (fneqs (log(ten), 2.302585092994046, 1e-6)) failed("log(%S)",ten); if (fneqs (exp(one), E, 1e-6)) failed("exp(%S)",one); if (log10(ten) != 1) failed("log10(%S)", ten); - +#ifexists Complex_Type if (Imag(one) != 0) failed ("Imag(%S)", one); if (Real(one) != 1) failed ("Real(%S)", one); if (Conj(one) != 1) failed ("Conj(%S)", one); - +#endif one = one, one, one; ten = ten,ten,ten; if (any(fneqs (tan(one), 1.5574077246549023, 1e-6))) failed("tan(%S)",one); @@ -363,9 +363,11 @@ if (any(fneqs (log(ten), 2.302585092994046, 1e-6))) failed("log(%S)",ten); if (any(fneqs (exp(one), E, 1e-6))) failed("exp(%S)",one); if (any(log10(ten) != 1)) failed("log10(%S)", ten); +#ifexists Complex_Type if (any(Imag(one) != 0)) failed ("Imag(%S)", one); if (any(Real(one) != 1)) failed ("Real(%S)", one); if (any(Conj(one) != 1)) failed ("Conj(%S)", one); +#endif } } test_misc_trig ();
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/multline.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/multline.sl
Changed
@@ -13,15 +13,20 @@ ml = eval(`"` + ml + `";`); if (str != ml) { - failed ("%s --> %s", str, ml); + failed ("\n1: %s --> %s", str, ml); } ml = break_string (str, "\n"); ml = eval(```` + ml + ```;`); if (str != ml) { - failed ("%s --> %s", str, ml); + failed ("\n2: %s --> %s", str, ml); } + + ml = break_string (str, "\\n\\\r\n"); + ml = eval ("\"" + ml + "\""); + if (str != ml) + failed ("\n3: %s --> %s", str, ml); } test_string ("1 This is\na multiline\nstring\n"); @@ -41,16 +46,25 @@ test_string2 (`3 This is\\\na multiline\nstring\nX`Q, "3 This is\\\na multiline\nstring\nX"); -eval("\ -define test_string3 (str, ans)\n\ +private variable Test_String_Body = "\n\ {\n\ if (str != ans)\n\ {\n\ - failed (\"str != ans, where str=%S, ans=%S\", str, ans);\n\ + failed (\"str != ans, where\\nstr=%S,\\nans=%S\\n\", str, ans);\n\ return;\n\ }\n\ }\n\ -"); +"; + +eval ("define test_string3a (str, ans)" + Test_String_Body); +eval ("define test_string3b (str, ans)" + strreplace(Test_String_Body, "\n", "\r\n")); + +private define test_string3 (a, b) +{ + test_string3a (a, b); + test_string3b (a, b); +} + test_string3 (`2 This is\na multiline\nstring\n`, "2 This is\\na multiline\\nstring\\n"); test_string3 (`3 This is\\\na multiline\nstring\nX`Q, @@ -67,6 +81,9 @@ string\0`BQ, "6 This is\n a \0 binary\n string\0"); +test_string3 (eval("`7 This is\r\n a \\0 binary\r\n string\\0`BQ"), + "7 This is\r\n a \0 binary\r\n string\0"); + print ("Ok\n"); exit (0);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/posdir.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/posdir.sl
Changed
@@ -45,12 +45,30 @@ } test_posdir (); +private define compare_stat (st, st1) +{ + if ((st1.st_dev != st.st_dev) + || (st1.st_ino != st.st_ino)) + failed ("stat compare"); +} + private define test_non_exist_file_ops () { variable badfile = "/122345 user"; if (NULL == stat_file (badfile)) () = remove (badfile); % should fail variable tmpfile = util_make_tmp_file ("tmpfileX", NULL); + variable st = stat_file (tmpfile); + if (st == NULL) + failed ("stat_file tmpfile"); + variable fp = fopen (tmpfile, "r"); + variable st1 = stat_file (fp); + if (st1 == NULL) failed ("stat_file fp"); + compare_stat (st, st1); + st1 = stat_file (fileno(fp)); + if (st1 == NULL) failed ("stat_file fileno(fp)"); + compare_stat (st, st1); + variable tmpfile1 = tmpfile + "-tmp"; variable tmpdir = util_make_tmp_dir ("tmpdir"); variable dir = getcwd (); @@ -76,7 +94,7 @@ #ifexists symlink if (-1 == symlink (tmpfile, tmpfile1)) failed ("symlink %s -> %s: %S", tmpfile1, tmpfile, errno_string()); - variable st = lstat_file (tmpfile1); + st = lstat_file (tmpfile1); if ((st == NULL) || (0 == stat_is ("lnk", st.st_mode))) failed ("stat_is lnk for %s", tmpfile1); if (-1 != symlink ("", ""))
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/posixio.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/posixio.sl
Changed
@@ -8,7 +8,9 @@ variable new_text, nbytes, len; variable pos; - file = util_make_tmp_file ("tmpfile", &fd); + % Avoid an NFS mount. The flock function can fail if lockd is not + % running on the server + file = util_make_tmp_file ("/tmp/sltest-tmpfile", &fd); if (-1 == write (fd, some_text)) failed ("write"); @@ -45,6 +47,23 @@ if (bstrlen (new_text)) failed ("read at EOF"); + if (0 == flock (fd, LOCK_EX)) + { + variable fp = fopen (file, "r"); + if ((-1 != flock (fp, LOCK_EX|LOCK_NB)) + || (errno != EWOULDBLOCK)) + { + () = failed ("flock LOCK_NB"); + } + () = fclose (fp); + } + else failed ("flock LOCK_EX: %S", errno_string()); + + if (-1 == flock (fd, LOCK_UN)) + { + failed ("flock LOCK_UN: %S", errno_string()); + } + if (-1 == _close (_fileno(fd))) failed ("_close after tests"); if (0 == close (fd)) failed ("Expected close to fail since _close was already used");
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/qualif.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/qualif.sl
Changed
@@ -318,6 +318,29 @@ } test_intrinsic_qualifiers (); +private define check_qualifier (x) +{ + return x + qualifier ("bar", 0); +} + +private define test_array_map_qualifiers (dx) +{ + variable x = 1:10; + variable y = array_map (Int_Type, &check_qualifier, x; bar=dx); + ifnot (_eqs (y, x+dx)) + { + () = array_map (Int_Type, &fprintf, stdout, "%d, %d\n", y, x+dx); + failed ("array_map with explicit qualifiers failed"); + } + y = array_map (Int_Type, &check_qualifier, x;; __qualifiers); + ifnot (_eqs (y, x + qualifier("bar", 0))) + { + failed ("array_map with implicit qualifier failed"); + } +} +test_array_map_qualifiers (11; bar=130, foo=1); +test_array_map_qualifiers (11); + print ("Ok\n"); exit (0);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/regexp.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/regexp.sl
Changed
@@ -24,12 +24,28 @@ test_regexp (`.*d`, "ffdoodfoo fob", 1, "ffdood"); test_regexp (`.?d`, "ffdoodfoo fob", 2, "fd"); test_regexp (`.+d`, "ffdoodfoo fob", 1, "ffdood"); -test_regexp (`.\{1,3\}d`, "ffdoodfoo fob", 1, "ffd"); -test_regexp (`.\{1,\}d`, "ffdoodfoo fob", 1, "ffdood"); -test_regexp (`.\{4,\}d`, "ffdoodfoo fob", 1, "ffdood"); -test_regexp (`.\{3,4\}d`, "ffdoodfoo fob", 2, "fdood"); + +% Looping test the RE cache +loop (7) +{ + test_regexp (`.\{1,3\}d`, "ffdoodfoo fob", 1, "ffd"); + loop (5) + { + test_regexp (`.\{1,\}d`, "ffdoodfoo fob", 1, "ffdood"); + loop (3) + { + test_regexp (`.\{4,\}d`, "ffdoodfoo fob", 1, "ffdood"); + test_regexp (`.\{3,4\}d`, "ffdoodfoo fob", 2, "fdood"); + } + } +} + test_regexp (`.\{3\}d`, "ffdoodfoo fob", 3, "dood"); +test_regexp(`\s+fo\so`, "fo o fo od", 5, " fo o"); +test_regexp(`\s+\S+\s?d`, "fo o fo od", 11, " od"); +test_regexp(`\s+\S+\s?o`, "fo o fo od", 5, " fo o"); + test_regexp (`\cA-Z+`, "fooFOO4", 4, "FOO"); test_regexp (`\CA-Z+`, "fooFOO4", 1, "fooFOO"); test_regexp (`\<fo+`, "ffoodfoo fob", 10, "fo"); @@ -137,6 +153,7 @@ test_regexp_match (`=\(\d+\)`, "L=12X", 2, "12"); test_regexp_match (`=\(\d*\)`, "L=1X", 2, "1"); test_regexp_match (`=\(\d*\)`, "L=X", 2, ""); +test_regexp_match (`\D+\d+\D?\(\d+\)`, "L=12X13", 1, "13"); static define test_globbing (glob, re) {
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/sltest.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/sltest.c
Changed
@@ -177,6 +177,8 @@ MAKE_CSTRUCT_FIELD(CStruct_Type, i, "i", SLANG_INT_TYPE, 0), #if SLANG_HAS_FLOAT MAKE_CSTRUCT_FIELD(CStruct_Type, d, "d", SLANG_DOUBLE_TYPE, 0), +#endif +#if SLANG_HAS_COMPLEX MAKE_CSTRUCT_FIELD(CStruct_Type, c, "z", SLANG_COMPLEX_TYPE, 0), #endif MAKE_CSTRUCT_FIELD(CStruct_Type, s, "s", SLANG_STRING_TYPE, 0),
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/stdio.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/stdio.sl
Changed
@@ -268,23 +268,58 @@ static define test_fgetsputslines () { - variable lines = array_map (String_Type, &string, 1:1000); + variable lines, lines1; + + lines = array_map (String_Type, &string, 1:1000); lines += "\n"; - variable file; - variable fp = fopen_tmp_file (&file, "w"); + + variable fp, file; + + fp = fopen_tmp_file (&file, "w"); if (length (lines) != fputslines (lines, fp)) failed ("fputslines"); if (-1 == fclose (fp)) failed ("fputslines;fclose"); + fp = fopen (file, "r"); if (fp == NULL) failed ("fputslines...fopen"); - variable lines1 = fgetslines (fp); + lines1 = fgetslines (fp); if (0 == _eqs (lines1, lines)) failed ("fgetslines"); ()=fclose (fp); if (-1 == remove (file)) failed ("remove:" + errno_string(errno)); + + lines = array_map (String_Type, &string, 1:1000); + lines10:20:3 = ""; + lines = " \t" + lines + " \n"; + + variable a = Array_Type4; + a0 = lines; + a1 = strtrim_end (lines); + a2 = strtrim_beg (lines); + a3 = strtrim (lines); + + fp = fopen_tmp_file (&file, "w"); + if (length (lines) != fputslines (lines, fp)) + failed ("fputslines"); + if (-1 == fclose (fp)) + failed ("fputslines;fclose"); + + _for (0, 3, 1) + { + variable t = (); + fp = fopen (file, "r"); + if (fp == NULL) + failed ("fputslines...fopen"); + ifnot (_eqs (at, fgetslines (fp; trim=t))) + failed ("fgetslines with trim=%d", t); + () = fclose (fp); + } + + if (-1 == remove (file)) + failed ("remove:" + errno_string(errno)); } test_fgetsputslines ();
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/strops.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/strops.sl
Changed
@@ -990,8 +990,34 @@ if (us != cs) failed ("sprintf %%c with signed and unsigned char"); + + variable ans = " 6"; + variable s = sprintf ("%*d", 4, 6); + if (s != ans) + failed ("sprintf (%%*d, 4, 6) ==> \"%S\", expected \"%S\"", s, ans); + + ans = "0006"; + if (ans != sprintf ("%0*d", 4, 6)) + failed ("sprintf (%%0*d, 4, 6)"); } + test_sprintf (); +private define test_issubstr () +{ + variable a = String_Type4; + a2 = "foobar"; + a3 = "oo"; + + variable i = where(is_substr (a, "foo")); + ifnot (_eqs (i, 2)) + failed ("test_issubstr: foo"); + + i = where (is_substr ("oo", a)); + ifnot (_eqs (i, 3)) + failed ("test_issubstr: oo"); +} +test_issubstr (); + print ("Ok\n"); exit (0);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/test/struct.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/test/struct.sl
Changed
@@ -478,6 +478,7 @@ } __add_typecast (Vector_Type, List_Type, &vector_to_list); +#ifexists Complex_Type private define vector_to_complex (v) { return v.x + 1j*v.y; @@ -487,6 +488,7 @@ return (vector_to_complex (v) == z); } __add_typecast (Vector_Type, Complex_Type, &vector_to_complex); +#endif private define vector_to_stdout (v) { @@ -518,7 +520,10 @@ failed ("simple vector not equal to %S", to); v = vector(4,5,6), vector (7,8,9), - vector (1i,2i,3i); +#ifexists Complex_Type + vector (1i,2i,3i) +#endif + ; l = typecast (v, to); _for (0, length (v)-1, 1) { @@ -528,7 +533,9 @@ } } test_typecast (List_Type, &is_vector_eq_to_list); +#ifexists Complex_Type test_typecast (Complex_Type, &is_vector_eq_to_complex); +#endif test_typecast (File_Type, &is_vector_eq_to_stdout); test_typecast (String_Type, &is_vector_eq_to_string);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/untic.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/untic.c
Changed
@@ -8,6 +8,36 @@ exit (1); } +static void print_string_cap (const char *name, unsigned char *str, char *comment) +{ + fprintf (stdout, "\t%s=", name); + while (*str) + { + if ((int) (*str & 0x7F) < ' ') + { + putc ('^', stdout); + *str += '@'; + } + putc (*str, stdout); + str++; + } + if (comment != NULL) + fprintf (stdout, "\t\t%s", comment); + putc ('\n', stdout); +} + +static void print_bool_cap (const char *name, char *comment) +{ + fprintf (stdout, "\t%s\t\t%s\n", name, + ((comment == NULL) ? "" : comment)); +} + +static void print_numeric_cap (const char *name, int val, char *comment) +{ + fprintf (stdout, "\t%s#%d\t\t%s\n", name, val, + ((comment == NULL) ? "" : comment)); +} + int main (int argc, char **argv) { SLterminfo_Type *t; @@ -44,20 +74,7 @@ /* str = (unsigned char *) "NULL"; */ } - fprintf (stdout, "\t%s=", map->name); - while (*str) - { - if ((int) (*str & 0x7F) < ' ') - { - putc ('^', stdout); - *str += '@'; - } - putc (*str, stdout); - str++; - } - if (map->comment != NULL) - fprintf (stdout, "\t\t%s", map->comment); - putc ('\n', stdout); + print_string_cap (map->name, str, map->comment); map++; } @@ -65,11 +82,7 @@ while (*map->name != 0) { if (_pSLtt_tigetflag (t, map->name) > 0) - { - fprintf (stdout, "\t%s\t\t%s\n", - map->name, - ((map->comment == NULL) ? "" : map->comment)); - } + print_bool_cap (map->name, map->comment); map++; } map = Tgetnum_Map; @@ -77,12 +90,35 @@ { int val; if ((val = SLtt_tigetnum ((SLFUTURE_CONST char *)map->name, (char **) &t)) >= 0) + print_numeric_cap (map->name, val, map->comment); + + map++; + } + + if (t->ext != NULL) + { + Extended_Cap_Type *e = t->ext; + int i; + + fprintf (stdout, "Local Extensions:\n"); + for (i = 0; i < e->num_string; i++) { - fprintf (stdout, "\t%s#%d\t\t%s\n", - map->name, val, - ((map->comment == NULL) ? "" : map->comment)); + str = (unsigned char *) SLtt_tigetstr ((SLFUTURE_CONST char *)e->string_capsi, (char **) &t); + if (str != NULL) print_string_cap (e->string_capsi, str, NULL); + } + + for (i = 0; i < e->num_bool; i++) + { + if (_pSLtt_tigetflag (t, e->bool_capsi) > 0) + print_bool_cap (e->bool_capsi, NULL); + } + + for (i = 0; i < e->num_numeric; i++) + { + int val; + if ((val = SLtt_tigetnum ((SLFUTURE_CONST char *)e->numeric_capsi, (char **) &t)) >= 0) + print_numeric_cap (e->numeric_capsi, val, NULL); } - map++; } _pSLtt_tifreeent (t);
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/util/mkslarith2.sl -> _service:tar_scm:slang-2.3.3.tar.bz2/src/util/mkslarith2.sl
Changed
@@ -1,235 +1,417 @@ -#!/usr/bin/env slsh - -private variable CTypes = - "signed char", "unsigned char", "short", "unsigned short", "int", "unsigned int", - "long", "unsigned long", "long long", "unsigned long long", - "float", "double", "long double"; -private variable Is_Int_Type = - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0; - -private variable Precedence = - 0, 0, 0, 0, 1, 1, 2, 2, 3, 3, 4, 5, 6; - -private variable SLTypes = - "CHAR", "UCHAR", "SHORT", "USHORT", "INT", "UINT", - "LONG", "ULONG", "LLONG", "ULLONG", - "FLOAT", "DOUBLE", "LDOUBLE"; -private variable FNames = - "char", "uchar", "short", "ushort", "int", "uint", - "long", "ulong", "llong", "ullong", - "float", "double", "ldouble"; -% private variable Compile_If = -% "", "", "SHORT_IS_NOT_INT", "SHORT_IS_NOT_INT", "", "", -% "LONG_IS_NOT_INT", "LONG_IS_NOT_INT", -% "defined(HAVE_LONG_LONG)", "defined(HAVE_LONG_LONG)", -% "SLANG_HAS_FLOAT", "SLANG_HAS_FLOAT", "defined(HAVE_LONG_DOUBLE)"; -private variable Compile_If = - "", "", "", "", "", "", "", "", - "defined(HAVE_LONG_LONG)", "defined(HAVE_LONG_LONG)", - "SLANG_HAS_FLOAT", "SLANG_HAS_FLOAT", "defined(HAVE_LONG_DOUBLE)"; - -private variable Else_Alias = - "", "", "int", "uint", "", "", "int", "uint", "", "", "", "", ""; - -define mkarith_copy_funs (fp) +private variable Type_Info_List = {}; +private define add_type_info (ctype, sltype, fname, + isdefined, ifnot_alias, elsealias, + isfloat, rank) { - variable ntypes = length (CTypes); - variable i, j; - _for i (0, ntypes-1, 1) + variable is_small_int = is_substr (ctype, "short") || is_substr(ctype, "char"); + variable is_unsigned = is_substr (ctype, "unsigned"); + variable pow_function = "pow((double)(a),(double)(b))"; + variable pow_result_type = "double"; + if (ctype == "float") pow_result_type = "float"; + if (ctype == "long double") { - variable ctype = CTypesi; - variable is_int = Is_Int_Typei; - variable sltype = SLTypesi; - variable fname = FNamesi; - variable compile_if = Compile_Ifi; - variable prec = Precedencei; - variable else_alias = Else_Aliasi; - variable s_fname = fname; - if (s_fname0 == 'u') s_fname = substr (s_fname, 2, -1); + pow_function = "lpow(($ctype)(a),($ctype)(b))"$; + pow_result_type = ctype; + } - () = fprintf (fp, "/* ------------ %s ---------- */\n", ctype); + variable fname_signed = fname, ctype_unsigned = ctype; + if (is_unsigned) + { + fname_signed = fname_signed1:; % uint --> int + ctype_unsigned = strtrim (strreplace(ctype, "unsigned", "")); + } - if (compile_if != "") - () = fprintf (fp, "#if %s\n", compile_if); + % fname_signed is the signed counterpart of an unsigned name - variable is_long = (s_fname == "long"); + variable s = struct + { + ctype = ctype, sltype = sltype, fname = fname, + fname_signed = fname_signed, isdefined = isdefined, + ifnot_alias = ifnot_alias, else_alias = elsealias, + isfloat = isfloat, is_unsigned = is_unsigned, + rank = rank, is_small_int = is_small_int, + pow_function = "pow((double)(a),(double)(b))", + pow_result_type = "double", + mod_function = "((a) % (b))", + abs_function = (is_unsigned) ? "(a)" : "abs(a)", + push_scalar_fun = "SLclass_push_${fname_signed}_obj(SLANG_${sltype}_TYPE, ($ctype_unsigned)(a))"$, + push_pow_fun = "SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (a))", + }; + + if (is_small_int) + { + s.push_scalar_fun = "SLclass_push_int_obj(SLANG_INT_TYPE, (int)(a))"; + } - _for j (0, ntypes-1, 1) - { - variable ctype1 = CTypesj; - variable is_int1 = Is_Int_Typej; - variable sltype1 = SLTypesj; - variable fname1 = FNamesj; - variable compile_if1 = Compile_Ifj; - variable else_alias1 = Else_Aliasj; - variable prec1 = Precedencej; - variable s_fname1; - - if (compile_if1 != "") - () = fprintf (fp, "#if %s\n", compile_if1); - - s_fname1 = fname1; - if (s_fname10 == 'u') s_fname1 = substr (s_fname1, 2, -1); - variable is_long1 = (s_fname1 == "long"); - variable is_conditional = is_long || is_long1; - - variable def1 = sprintf ("copy_%s_to_%s", fname, fname1); - variable def2 = sprintf ("%s_to_%s", fname, fname1); - - if ((s_fname1 == s_fname) - and ((s_fname1 != fname1) or (s_fname != fname))) - () = fprintf (fp, "#define copy_%s_to_%s\tcopy_%s_to_%s\n", - fname, fname1, s_fname, s_fname1); - else - { - if (is_conditional) - { - () = fputs ("#if LONG_IS_INT\n", fp); - if (is_long1) - () = fputs ("# define $def1 copy_${fname}_to_${else_alias1}\n"$, fp); - else - () = fputs ("# define $def1 copy_${else_alias}_to_${fname1}\n"$, fp); - () = fputs ("#else\n", fp); - } - () = fputs ("DEFUN_1($def1,$ctype,$ctype1)\n"$, fp); - if (is_conditional) - () = fputs ("#endif\n", fp); - } + if (ctype == "long") s.abs_function = "labs(a)"; + if (ctype == "long long") s.abs_function = ("(((a) >= 0) ? (a) : -(a))"); + if (ctype == "float") + { + s.pow_result_type = ctype; + s.mod_function = "(float)fmod((a),(b))"; + s.abs_function = "(float)fabs((double)(a))"; + s.push_pow_fun = "SLclass_push_float_obj(SLANG_FLOAT_TYPE,(a))"; + } + if (ctype == "double") + { + s.mod_function = "fmod((a),(b))"; + s.abs_function = "fabs(a)"; + } + if (ctype == "long double") + { + s.pow_function = "lpow(($ctype)(a),($ctype)(b))"$; + s.pow_result_type = ctype; + s.abs_function = "fabsl(a)"; + s.mod_function = "fmodl((a),(b))"; + s.push_pow_fun = "SLclass_push_ldouble_obj(SLANG_LDOUBLE_TYPE,(a))"; + } + %print (s); + list_append (Type_Info_List, s); +} - if (prec < prec1) - { - if (is_conditional) - { - () = fputs ("#if LONG_IS_INT\n", fp); - if (is_long1) - () = fputs ("# define $def2 ${fname}_to_${else_alias1}\n"$, fp); - else - () = fputs ("# define $def2 ${else_alias}_to_${fname1}\n"$, fp); - () = fputs ("#else\n", fp); - } - () = fputs ("DEFUN_2($def2,$ctype,$ctype1,$def1)\n"$, fp); - if (is_conditional) - () = fputs ("#endif\n", fp); - } - else - { - () = fprintf (fp, "#define %s_to_%s\tNULL\n", fname, fname1); - } -#iffalse - if (else_alias != "") - { - () = fprintf (fp, "#else\n"); - () = fprintf (fp, "# define copy_%s_to_%s\tcopy_%s_to_%s\n", - fname, fname1, fname, else_alias); - if (prec < prec1) - { - if (fname != else_alias) - () = fprintf (fp, "# define %s_to_%s\t%s_to_%s\n", - fname, fname1, fname, else_alias); - } - } -#endif - if (compile_if1 != "") - () = fprintf (fp, "#endif /* %s */\n", compile_if1); - } +add_type_info ("signed char", "CHAR", "char", NULL, NULL, NULL, 0, 1); +add_type_info ("unsigned char", "UCHAR", "uchar", NULL, NULL, NULL, 0, 1); +add_type_info ("short", "SHORT", "short", NULL, "SHORT_IS_NOT_INT", "int", 0, 2); +add_type_info ("unsigned short", "USHORT", "ushort", NULL, "SHORT_IS_NOT_INT", "uint", 0, 2); +add_type_info ("int", "INT", "int", NULL, NULL, NULL, 0, 3); +add_type_info ("unsigned int", "UINT", "uint", NULL, NULL, NULL, 0, 3); +add_type_info ("long", "LONG", "long", NULL, "LONG_IS_NOT_INT", "int", 0, 4); +add_type_info ("unsigned long", "ULONG", "ulong", NULL, "LONG_IS_NOT_INT", "uint", 0, 4); +add_type_info ("long long", "LLONG", "llong", "defined(HAVE_LONG_LONG)", "LLONG_IS_NOT_LONG", "long", 0, 5); +add_type_info ("unsigned long long", "ULLONG", "ullong", "defined(HAVE_LONG_LONG)", "LLONG_IS_NOT_LONG", "ulong", 0, 5); +add_type_info ("float", "FLOAT", "float", "SLANG_HAS_FLOAT", NULL, NULL, 1, 6); +add_type_info ("double", "DOUBLE", "double", "SLANG_HAS_FLOAT", NULL, NULL, 1, 7); +add_type_info ("long double", "LDOUBLE", "ldouble", "defined(HAVE_LONG_DOUBLE)", NULL, NULL, 1, 8); + +private variable Indent = 0; + +private define output (s) +{ + () = fputs (s, stdout); +} - () = fprintf (fp, "#if SLANG_HAS_FLOAT\n"); - () = fprintf (fp, "TO_DOUBLE_FUN(%s_to_one_double,%s)\n", - fname, ctype); - () = fprintf (fp, "#endif\n"); +private define indent () +{ + loop (Indent) + output (" "); +} - if (compile_if != "") - () = fprintf (fp, "#endif /* %s */\n", compile_if); +private define output_if (s) +{ + if (s == NULL) return; + indent (); + () = fprintf (stdout, "#if %s\n", s); + Indent++; +} - () = fprintf (fp, "\n"); - } +private define output_else () +{ + Indent--; + indent (); + () = fprintf (stdout, "#else\n"); + Indent++; } -define mk_to_double_table (fp) +private define output_endif (s) { - variable ntypes = length (CTypes); + Indent--; + indent (); + () = fprintf (stdout, "#endif /* %S */\n", s); +} - () = fprintf (fp, "#if SLANG_HAS_FLOAT\n"); - () = fprintf (fp, "static To_Double_Fun_Table_Type To_Double_Fun_Table MAX_ARITHMETIC_TYPES =\n{\n"); +private define output_define (a,b) +{ + indent (); + () = fprintf (stdout, "#define %s %S\n", a, b); +} + +private define output_comment (s) +{ + () = fprintf (stdout, "/* %S */\n", s); +} - variable i; - _for i (0, ntypes-1, 1) +private define output_newline () +{ + () = fputs ("\n", stdout); +} + +private define output_include (s) +{ + indent (); + () = fprintf (stdout, "#include %S\n", s); +} + +private define mk_to_double_table () +{ + output_if ("SLANG_HAS_FLOAT"); + output ("static To_Double_Fun_Table_Type To_Double_Fun_Table MAX_ARITHMETIC_TYPES =\n{\n"); + + variable ainfo; + foreach ainfo (Type_Info_List) { - variable ctype = CTypesi; - variable compile_if = Compile_Ifi; - variable fname = FNamesi; - - if (compile_if != "") - () = fprintf (fp, "#if %s\n", compile_if); - () = fprintf (fp, " {sizeof(%s), %s_to_one_double},\n", ctype, fname); - if (compile_if != "") + variable fname = ainfo.fname, ctype = ainfo.ctype; + + output_if (ainfo.isdefined); + output (" {sizeof(${ctype}), ${fname}_to_one_double},\n"$); + if (ainfo.isdefined != NULL) { - () = fprintf (fp, "#else\n"); - () = fprintf (fp, " {0, NULL},\n#endif\n"); + output_else(); + output(" {0, NULL},\n"); + output_endif(ainfo.isdefined); } } - () = fprintf (fp, "};\n#endif\n\n"); + output ("};\n"); + output_endif ("SLANG_HAS_FLOAT"); + output_newline (); } -private define mk_binary_table (fp) +private define mk_binary_matrix () { - variable ntypes = length (CTypes); - variable i, j; + output ("static Binary_Matrix_Type Binary_Matrix MAX_ARITHMETIC_TYPESMAX_ARITHMETIC_TYPES =\n{\n"); - () = fprintf (fp, "static Binary_Matrix_Type Binary_Matrix MAX_ARITHMETIC_TYPESMAX_ARITHMETIC_TYPES =\n{\n"); + variable ainfo, binfo; - _for i (0, ntypes-1, 1) + foreach ainfo (Type_Info_List) { - variable fname = FNamesi; - variable compile_if = Compile_Ifi; + variable actype = ainfo.ctype; + variable afname = ainfo.fname; + + output_comment (actype); + + if (ainfo.isdefined != NULL) output_if (ainfo.isdefined); + + output ( " {\n"); + foreach binfo (Type_Info_List) + { + variable bfname = binfo.fname; + + output_if (binfo.isdefined); - () = fprintf (fp, " /* %s */\n", CTypesi); + variable copy_function = "(SLFvoid_Star)copy_${afname}_to_${bfname}"$; + variable bin_func_name = "${afname}_${bfname}_bin_op"$; + variable conv_function = "${afname}_to_${bfname}"$; - if (compile_if != "") - () = fprintf (fp, "#if %s\n", compile_if); + output (" {${copy_function}, ${conv_function}, ${bin_func_name}},\n"$); + if (binfo.isdefined != NULL) + { + output_else (); + output (" {NULL, NULL, NULL},\n"); + output_endif (binfo.isdefined); + } + } + output (" },\n"); - () = fprintf (fp, " {\n"); + if (ainfo.isdefined != NULL) + { + output_else (); + output (" {\n"); + loop (length (Type_Info_List)) + { + output (" {NULL, NULL, NULL},\n"); + } + output (" },\n"); + output_endif (ainfo.isdefined); + } + } + output ("};\n\n"); +} - _for j (0, ntypes-1, 1) +private define mk_defines () +{ + variable ainfo, binfo; + foreach ainfo (Type_Info_List) + { + variable afname = ainfo.fname; + variable actype = ainfo.ctype; + variable afname_signed = ainfo.fname_signed; + + variable cmp_func_name = "${afname}_cmp_function"$; + variable unary_func_name = "${afname}_unary_op"$; + variable to_binary_func_name = NULL; + if ((ainfo.isfloat == 0) && (ainfo.is_unsigned)) + to_binary_func_name = "${afname}_to_binary"$; + variable to_double_funct_name = "${afname}_to_one_double"$; + + output_comment (actype); + output_if (ainfo.isdefined); + output_if (ainfo.ifnot_alias); + + foreach binfo (Type_Info_List) { - variable fname1 = FNamesj; - variable compile_if1 = Compile_Ifj; + variable bfname = binfo.fname; + variable bctype = binfo.ctype; + variable bfname_signed = binfo.fname_signed; + + variable bin_func_name = "${afname}_${bfname}_bin_op"$; + variable scalar_bin_func_name = "${afname}_${bfname}_scalar_bin_op"$; + variable copy_function = "copy_${afname}_to_${bfname}"$; + variable conv_function = "${afname}_to_${bfname}"$; + + output_comment ("(${actype}, ${bctype})"$); + if (ainfo != binfo) + { + output_if (binfo.isdefined); + output_if (binfo.ifnot_alias); + } - if (compile_if1 != "") - () = fprintf (fp, "#if %s\n", compile_if1); + % To reduce the code size, create binary functions for + % the diagonal terms or off-diagonal elements involving + % int and double + variable off_diagonal_types = "int", "double"; + if ((ainfo == binfo) + || any (actype == off_diagonal_types) + || any (bctype == off_diagonal_types)) + { + output_define ("GENERIC_BINARY_FUNCTION", bin_func_name); + } + else + output_define (bin_func_name, "NULL"); + + output_define ("GENERIC_A_TYPE", actype); + if (ainfo.is_unsigned) output_define ("GENERIC_A_TYPE_UNSIGNED", "1"); + + output_define ("GENERIC_B_TYPE", bctype); + if (binfo.is_unsigned) output_define ("GENERIC_B_TYPE_UNSIGNED", "1"); + + if (ainfo.is_small_int && binfo.is_small_int) + output_define ("GENERIC_C_TYPE", "int"); + else if (actype == bctype) + output_define ("GENERIC_C_TYPE", actype); + else if (ainfo.rank > binfo.rank) + output_define ("GENERIC_C_TYPE", actype); + else if ((binfo.rank > ainfo.rank) || (binfo.is_unsigned)) + output_define ("GENERIC_C_TYPE", bctype); + else + output_define ("GENERIC_C_TYPE", actype); - () = fprintf (fp, " {(FVOID_STAR)copy_%s_to_%s, %s_to_%s},\n", - fname, fname1, fname, fname1); + variable is_integer = not (ainfo.isfloat || binfo.isfloat); + if (is_integer) + output_define ("GENERIC_BIT_OPERATIONS", 1); + output_define ("TRAP_DIV_ZERO", is_integer); - if (compile_if1 == "") - continue; + if (ainfo.rank >= binfo.rank) + { + output_define ("POW_FUNCTION(a,b)", ainfo.pow_function); + output_define ("POW_RESULT_TYPE", ainfo.pow_result_type); + output_define ("MOD_FUNCTION(a,b)", ainfo.mod_function); + } + else + { + output_define ("POW_FUNCTION(a,b)", binfo.pow_function); + output_define ("POW_RESULT_TYPE", binfo.pow_result_type); + output_define ("MOD_FUNCTION(a,b)", binfo.mod_function); + } + + if (ainfo == binfo) + { + % The scalar binary functions are currently used on + % the diagonal. + if (ainfo.is_small_int) + { + output_define (scalar_bin_func_name, "int_int_scalar_bin_op"); + } + else + { + output_define ("SCALAR_BINARY_FUNCTION", scalar_bin_func_name); + output_define ("PUSH_SCALAR_OBJ_FUN(a)", ainfo.push_scalar_fun); + output_define ("PUSH_POW_OBJ_FUN(a)", ainfo.push_pow_fun); + } - () = fprintf (fp, "#else\n"); - () = fprintf (fp, " {NULL, NULL},\n"); - () = fprintf (fp, "#endif\n"); + output_define ("GENERIC_UNARY_FUNCTION", unary_func_name); + output_define ("ABS_FUNCTION(a)", ainfo.abs_function); + output_define ("CMP_FUNCTION", cmp_func_name); + if (to_binary_func_name != NULL) + output_define ("TO_BINARY_FUNCTION", to_binary_func_name); + + output_define ("TO_DOUBLE_FUNCTION", to_double_funct_name); + } + + if ((ainfo.rank == binfo.rank) + && (ainfo.is_unsigned || binfo.is_unsigned)) + { + % The same function may be used to copy both the + % unsigned and signed integers of the same rank. + output_define (copy_function, "copy_${afname_signed}_to_${bfname_signed}"$); + } + else + { + output_define ("GENERIC_COPY_FUNCTION", copy_function); + } + + % The convert function is only used to covert to higher ranked objects + if (ainfo.rank <= binfo.rank) + { + % Small ints always get converted to int + if (binfo.is_small_int) + output_define (conv_function, "${afname}_to_int"$); + else if (ainfo.rank == binfo.rank) + output_define (conv_function, "convert_self_to_self"); + else + output_define ("GENERIC_CONVERT_FUNCTION", conv_function); + } + else + output_define (conv_function, "NULL"); + + output_include ("\"slarith.inc\""); + + if (ainfo != binfo) + { + variable belse_alias = binfo.else_alias; + if (belse_alias != NULL) + { + output_else (); + output_define (bin_func_name, "${afname}_${belse_alias}_bin_op"$); + output_define (copy_function, "copy_${afname}_to_${belse_alias}"$); + output_define (conv_function, "${afname}_to_${belse_alias}"$); + + %if (ainfo == binfo) output_define (scalar_bin_func_name, "${afname}_${belse_alias}_scalar_bin_op"$); + + output_endif (binfo.ifnot_alias); + } + if (binfo.isdefined != NULL) output_endif (binfo.isdefined); + } + output_newline (); } - () = fprintf (fp, " },\n"); - if (compile_if == "") - continue; + variable aelse_alias = ainfo.else_alias; + if (aelse_alias != NULL) + { + output_else (); + foreach binfo (Type_Info_List) + { + bfname = binfo.fname; + variable bfname1 = bfname; + if (binfo == ainfo) + { + bfname1 = aelse_alias; + } + + output_define ("${afname}_${bfname}_bin_op"$, "${aelse_alias}_${bfname1}_bin_op"$); + output_define ("${afname}_${bfname}_scalar_bin_op"$, "${aelse_alias}_${bfname1}_scalar_bin_op"$); + output_define ("copy_${afname}_to_${bfname}"$, "copy_${aelse_alias}_to_${bfname1}"$); + output_define ("${afname}_to_${bfname}"$, "${aelse_alias}_to_${bfname1}"$); + } - () = fprintf (fp, "#else\n"); + output_define (unary_func_name, "${aelse_alias}_unary_op"$); + output_define (cmp_func_name, "${aelse_alias}_cmp_function"$); + if (to_binary_func_name != NULL) + output_define (to_binary_func_name, "${aelse_alias}_to_binary"$); + output_define (to_double_funct_name, "${aelse_alias}_to_one_double"$); - () = fprintf (fp, " {\n"); - loop (ntypes) - () = fprintf (fp, " {NULL, NULL},\n"); - () = fprintf (fp, " },\n"); - () = fprintf (fp, "#endif /* %s */\n\n", compile_if); + output_endif (ainfo.ifnot_alias); + } + if (ainfo.isdefined != NULL) output_endif (ainfo.isdefined); + output_newline (); } - () = fprintf (fp, "};\n\n"); + + output_newline (); } define slsh_main () { - variable fp = fopen ("slarith2.inc", "w"); - () = fputs ("/* DO NOT EDIT -- this file was generated by src/util/mkslarith2.sl */\n", fp); - mkarith_copy_funs (fp); - mk_to_double_table (fp); - mk_binary_table (fp); - () = fclose (fp); + () = fputs ("/* DO NOT EDIT -- this file was generated by src/util/mkslarith2.sl */\n", stdout); + + mk_defines (); + mk_binary_matrix (); + mk_to_double_table (); }
View file
_service:tar_scm:slang-2.3.2.tar.bz2/src/util/perfhash.c -> _service:tar_scm:slang-2.3.3.tar.bz2/src/util/perfhash.c
Changed
@@ -1,4 +1,4 @@ -/* Copyright (c) 1998-2017,2018 John E. Davis +/* Copyright (c) 1998-2021,2022 John E. Davis This file is part of the S-Lang Library. The S-Lang Library is free software; you can redistribute it and/or
Locations
Projects
Search
Status Monitor
Help
Open Build Service
OBS Manuals
API Documentation
OBS Portal
Reporting a Bug
Contact
Mailing List
Forums
Chat (IRC)
Twitter
Open Build Service (OBS)
is an
openSUSE project
.
浙ICP备2022010568号-2