- cmucl-cvs - mailman3.common-lisp.net

[Git][cmucl/cmucl][master] 2 commits: Fix 354: Add CI test for executables
by Raymond Toy (＠rtoy) 01 Sep '24

01 Sep '24

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 39c8b616 by Raymond Toy at 2024-09-01T14:24:21+00:00 Fix 354: Add CI test for executables - - - - - c1514a66 by Raymond Toy at 2024-09-01T14:24:22+00:00 Merge branch 'issue-354-add-executable-test-to-ci' into 'master' Fix 354: Add CI test for executables See merge request cmucl/cmucl!253 - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -98,6 +98,18 @@ linux:test: script: - bin/run-unit-tests.sh -l dist/bin/lisp 2>&1 | tee test.log +linux:exec-test: + stage: test + tags: + - linux + needs: + - job: linux:build + artifacts: true + script: + # Create an executable and test it by printing the version. + - dist/bin/lisp -eval '(save-lisp "saved-lisp-executable" :executable t)' + - ./saved-lisp-executable --version + linux:cross-test: stage: test tags: @@ -202,6 +214,18 @@ osx:test: - echo LANG = $LANG - bin/run-unit-tests.sh -l dist/bin/lisp 2>&1 | tee test.log +osx:exec-test: + stage: test + tags: + - macos-virtualbox + needs: + - job: osx:build + artifacts: true + script: + # Create an executable and test it by printing the version. + - dist/bin/lisp -eval '(save-lisp "saved-lisp-executable" :executable t)' + - ./saved-lisp-executable --version + osx:ansi-test: stage: ansi-test tags: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/5f6bce019825f201308835… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/5f6bce019825f201308835… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-352-new-compression-for-dist] Apply review suggestions.
by Raymond Toy (＠rtoy) 01 Sep '24

01 Sep '24

Raymond Toy pushed to branch issue-352-new-compression-for-dist at cmucl / cmucl Commits: 12fb0ea3 by Raymond Toy at 2024-09-01T06:31:51-07:00 Apply review suggestions. - - - - - 3 changed files: - bin/make-extra-dist.sh - bin/make-main-dist.sh - bin/make-src-dist.sh Changes: ===================================== bin/make-extra-dist.sh ===================================== @@ -1,22 +1,24 @@ #!/bin/sh usage() { - echo "make-extra-dist.sh -C option -E ext [-t tar] [-I destdir] [-G group] [-O owner]" - echo " -h This help" - echo " -? This help" - echo " -t tar Tar program to use" - echo " -C option Tar option for compressing the tarball; required." - echo " -E ext Extension to use for the tarball. Must be consistent with" - echo " -C option. Required." - echo " -I destdir Install directly to given directory instead of creating a tarball" - echo " -G group Group to use" - echo " -O owner Owner to use" - echo "" - echo "This is generally called by make-dist.sh and not normally invoked by the user" - echo "" - echo "Create a tarball of the extra components for cmucl. This includes things like " - echo "CLX; Hemlock; CLM; contrib library not already included in the main" - echo "distribution; locale messages." + cat <<EOF +`basename $0` -C option -E ext [-t tar] [-I destdir] [-G group] [-O owner] + -h This help + -? This help + -t tar Tar program to use + -C option Tar option for compressing the tarball; required. + -E ext Extension to use for the tarball. Must be consistent with + -C option. Required. + -I destdir Install directly to given directory instead of creating a tarball + -G group Group to use + -O owner Owner to use + +This is generally called by make-dist.sh and not normally invoked by the user + +Create a tarball of the extra components for cmucl. This includes things like +CLX; Hemlock; CLM; contrib library not already included in the main +distribution; locale messages. +EOF exit 1 } ===================================== bin/make-main-dist.sh ===================================== @@ -1,25 +1,27 @@ #!/bin/sh usage() { - echo "make-main-dist.sh -C option -E ext [-h?] [-t tar][-I destdir] [-G group] [-O owner] [-M mandir]" - echo " target-directory version arch os" - echo " -h This help" - echo " -? This help" - echo " -t tar Tar program to use" - echo " -C option Tar option for compressing the tarball; required." - echo " -E ext Extension to use for the tarball. Must be consistent with" - echo " -C option. Required." - echo " -I destdir Install directly to given directory instead of creating a tarball" - echo " -G group Group to use" - echo " -O owner Owner to use" - echo " -M mandir Install manpages in this subdirectory. Default is man/man1" - echo "" - echo "This is generally called by make-dist.sh and not normally invoked by the user" - echo "" - echo "Create a tarball consisting of the main components needed to distribute" - echo "a binary installation of cmucl. This includes the C executable and support" - echo "libraries; the subsystems like Gray streams, and simple streams; external" - echo "formats; contribs like asdf and defsystem; manpages and READMEs." + cat <<EOF +`basename $0` -C option -E ext [-h?] [-t tar][-I destdir] [-G group] [-O owner] [-M mandir] + target-directory version arch os + -h This help + -? This help + -t tar Tar program to use + -C option Tar option for compressing the tarball; required. + -E ext Extension to use for the tarball. Must be consistent with + -C option. Required. + -I destdir Install directly to given directory instead of creating a tarball + -G group Group to use + -O owner Owner to use + -M mandir Install manpages in this subdirectory. Default is man/man1 + +This is generally called by make-dist.sh and not normally invoked by the user + +Create a tarball consisting of the main components needed to distribute +a binary installation of cmucl. This includes the C executable and support +libraries; the subsystems like Gray streams, and simple streams; external +formats; contribs like asdf and defsystem; manpages and READMEs." +EOF exit 1 } ===================================== bin/make-src-dist.sh ===================================== @@ -1,21 +1,26 @@ #!/bin/sh usage() { - echo "make-src-dist.sh: -C option -E ext [-h?] [-t gnutar] [-I destdir] [version]" - echo " -h This help" - echo " -? This help" - echo " -t tar Name/path to GNU tar" - echo " -C option Tar option for compressing the tarball; required." - echo " -E ext Extension to use for the tarball. Must be consistent with" - echo " -C option. Required." - echo " -I destdir Install directly to given directory instead of creating a tarball" - echo " version The version. Defaults to the current date" - echo "" - echo "This is generally called by make-dist.sh and not normally invoked by the user" - echo "" - echo "Create a tar ball of the cmucl sources." + cat <<EOF +`basename $0` -C option -E ext [-h?] [-t gnutar] [-I destdir] [version] + -h This help + -? This help + -t tar Name/path to GNU tar + -C option Tar option for compressing the tarball; required. + -E ext Extension to use for the tarball. Must be consistent with + -C option. Required. + -I destdir Install directly to given directory instead of creating a tarball + version The version. Defaults to the current date + +This is generally called by make-dist.sh and not normally invoked by the user + +Create a tar ball of the cmucl sources." +EOF + exit 1 } +GTAR=tar + while getopts "C:E:h?t:I:" arg do case $arg in @@ -51,8 +56,8 @@ echo Creating source distribution GTAR_OPTIONS="--exclude=.git --exclude='*.pot.~*~'" if [ -z "$INSTALL_DIR" ]; then # echo " Compressing with $ZIP" - ${GTAR:-tar} ${GTAR_OPTIONS} ${COMPRESS} -cf cmucl-src-$VERSION.tar.$COMPRESS_EXT bin src tests + ${GTAR} ${GTAR_OPTIONS} ${COMPRESS} -cf cmucl-src-$VERSION.tar.$COMPRESS_EXT bin src tests else # Install in the specified directory - ${GTAR:-tar} ${GTAR_OPTIONS} -cf - bin src tests | (cd $INSTALL_DIR; ${GTAR:-tar} xf -) + ${GTAR} ${GTAR_OPTIONS} -cf - bin src tests | (cd $INSTALL_DIR; ${GTAR:-tar} xf -) fi View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/12fb0ea3d2c6e7dfd093fb9… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/12fb0ea3d2c6e7dfd093fb9… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-354-add-executable-test-to-ci] Rename foo to saved-lisp-executable
by Raymond Toy (＠rtoy) 01 Sep '24

01 Sep '24

Raymond Toy pushed to branch issue-354-add-executable-test-to-ci at cmucl / cmucl Commits: 4ae24455 by Raymond Toy at 2024-09-01T06:22:39-07:00 Rename foo to saved-lisp-executable - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -107,8 +107,8 @@ linux:exec-test: artifacts: true script: # Create an executable and test it by printing the version. - - dist/bin/lisp -eval '(save-lisp "foo" :executable t)' - - ./foo --version + - dist/bin/lisp -eval '(save-lisp "saved-lisp-executable" :executable t)' + - ./saved-lisp-executable --version linux:cross-test: stage: test @@ -223,8 +223,8 @@ osx:exec-test: artifacts: true script: # Create an executable and test it by printing the version. - - dist/bin/lisp -eval '(save-lisp "foo" :executable t)' - - ./foo --version + - dist/bin/lisp -eval '(save-lisp "saved-lisp-executable" :executable t)' + - ./saved-lisp-executable --version osx:ansi-test: stage: ansi-test View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/4ae24455fcc02021aaf467a… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/4ae24455fcc02021aaf467a… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Remove the call to malloc and strdup from obj_run_linker
by Carl Shapiro (＠cshapiro) 30 Aug '24

30 Aug '24

Carl Shapiro pushed to branch master at cmucl / cmucl Commits: 83899880 by Carl Shapiro at 2024-08-29T23:32:31-07:00 Remove the call to malloc and strdup from obj_run_linker - - - - - 5f6bce01 by Carl Shapiro at 2024-08-30T17:07:11+00:00 Merge branch 'obj-run-linker-no-malloc-or-strdup' into 'master' Remove the call to malloc and strdup from obj_run_linker Closes #309 See merge request cmucl/cmucl!251 - - - - - 1 changed file: - src/lisp/elf.c Changes: ===================================== src/lisp/elf.c ===================================== @@ -11,11 +11,11 @@ $Id: elf.c,v 1.32 2010/12/23 03:20:27 rtoy Exp $ */ +#include <stddef.h> #include <stdio.h> #include <stdlib.h> #include <string.h> #include <fcntl.h> -#include <sys/stat.h> #include <sys/types.h> #include <unistd.h> @@ -319,59 +319,65 @@ write_space_object(const char *dir, int id, os_vm_address_t start, os_vm_address return ret; } +#ifdef UNICODE +#define LISPCHAR unsigned short +#else +#define LISPCHAR char +#endif + +static LISPCHAR * +tokenize(LISPCHAR *str, LISPCHAR **end) +{ + LISPCHAR *ptr; + + ptr = str; +again: + while (*ptr != '\0' && *ptr != ':') + ptr++; + if (str == ptr && *ptr == ':') { + str = ++ptr; + goto again; + } + *end = ptr; + return str; +} + int obj_run_linker(long init_func_address, char *file) { lispobj libstring = SymbolValue(CMUCL_LIB); /* Get library: */ struct vector *vec = (struct vector *)PTR(libstring); - char *paths; - char command[FILENAME_MAX + 1]; - char command_line[FILENAME_MAX + FILENAME_MAX + 10]; - char *strptr; - struct stat st; + char command[PATH_MAX]; + char command_line[PATH_MAX * 2 + 10]; + LISPCHAR *strptr, *end = (LISPCHAR *)vec->data; int ret; extern int debug_lisp_search; -#ifndef UNICODE - paths = strdup((char *)vec->data); - if (paths == NULL) { - perror("strdup"); - return -1; - } -#else - /* - * What should we do here with 16-bit characters? For now we just - * take the low 8-bits. - */ - paths = malloc(vec->length); - if (paths == NULL) { - perror("malloc"); - return -1; - } else { - int k; - unsigned short *data; - data = (unsigned short*) vec->data; - - for (k = 0; k < vec->length; ++k) { - paths[k] = data[k] & 0xff; - } - } -#endif - strptr = strtok(paths, ":"); if (debug_lisp_search) { printf("Searching for linker.sh script\n"); } - while(strptr != NULL) { - - sprintf(command, "%s/%s", strptr, LINKER_SCRIPT); + while ((strptr = tokenize(end, &end)) != end) { + ptrdiff_t len = end - strptr; + ptrdiff_t i; + + if (len + strlen("/" LINKER_SCRIPT) > PATH_MAX) + continue; + + /* + * What should we do here with 16-bit characters? For now we just + * take the low 8-bits. + */ + for (i = 0; i < len; i++) + command[i] = strptr[i] & 0xFF; + command[i] = '\0'; + strcat(command, "/" LINKER_SCRIPT); if (debug_lisp_search) { printf(" %s\n", command); } - if (stat(command, &st) == 0) { - free(paths); + if (access(command, F_OK) == 0) { printf("\t[%s: linking %s... \n", command, file); fflush(stdout); #if defined(__linux__) || defined(__FreeBSD__) || defined(SOLARIS) || defined(__NetBSD__) @@ -394,15 +400,14 @@ obj_run_linker(long init_func_address, char *file) } return ret; } - strptr = strtok(NULL, ":"); } fprintf(stderr, "Can't find %s script in CMUCL library directory list.\n", LINKER_SCRIPT); - free(paths); return -1; } +#undef LISPCHAR /* Read the ELF header from a file descriptor and stuff it into a structure. Make sure it is really an elf header etc. */ View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/66dab205671d5bbc2f16e1… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/66dab205671d5bbc2f16e1… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-355-solaris-x86-fp-trap-handler] More debugging
by Raymond Toy (＠rtoy) 30 Aug '24

30 Aug '24

Raymond Toy pushed to branch issue-355-solaris-x86-fp-trap-handler at cmucl / cmucl Commits: 959faae1 by Raymond Toy at 2024-08-29T20:47:11-07:00 More debugging Add C functions to get the x87 and sse2 modes from the sigcontext. Also add functions to set the modes in the sigcontext. Make these available to Lisp. Use these functions in sigfpe-handler to examine the modes and to clear out the current exception. Still needs work. Overflow is signaled correctly, but after aborting, the FP modes still contains the exception. - - - - - 3 changed files: - src/code/float-trap.lisp - src/code/x86-vm.lisp - src/lisp/solaris-os.c Changes: ===================================== src/code/float-trap.lisp ===================================== @@ -482,6 +482,13 @@ (let* ((modes (sigcontext-floating-point-modes (alien:sap-alien scp (* unix:sigcontext))))) (format t "Current modes: ~32,'0b~%" modes) + (format t "sigcontext x87: ~32,'0b~%" + (sigcontext-floating-point-modes-x87 + (alien:sap-alien scp (* unix:sigcontext)))) + (format t "sigcontext sse2: ~32,'0b~%" + (sigcontext-floating-point-modes-sse2 + (alien:sap-alien scp (* unix:sigcontext)))) + (multiple-value-bind (fop operands) (let ((sym (find-symbol "GET-FP-OPERANDS" "VM"))) (if (fboundp sym) @@ -529,14 +536,19 @@ (format t "new x87 modes: ~32,'0b~%" (vm::x87-floating-point-modes)) (format t "new sse2 modes: ~32,'0b~%" (vm::sse2-floating-point-modes))) (let* ((trap-bit (third (assoc code +fpe-code-info-alist+))) - (new-modes - (dpb (logandc2 (ldb float-exceptions-byte modes) - trap-bit) - float-exceptions-byte modes))) - (format t "New modes: ~32,'0b~%" new-modes) - (setf (sigcontext-floating-point-modes) - (alien:sap-alien scp (* unix:sigcontext)) - new-modes)))))) + (x87-modes (sigcontext-floating-point-modes-x87 + (alien:sap-alien scp (* unix:sigcontext)))) + (sse2-modes (sigcontext-floating-point-modes-sse2 + (alien:sap-alien scp (* unix:sigcontext))))) + (format t "Trap bit: ~D~%" trap-bit) + (format t "New sigcontext x87: ~32,'0b~%" (logandc2 x87-modes trap-bit)) + (format t "New sigcontext sse2: ~32,'0b~%" (logandc2 sse2-modes trap-bit)) + (%set-sigcontext-floating-point-modes-x87 + (alien:sap-alien scp (* unix:sigcontext)) + (logandc2 x87-modes trap-bit)) + (%set-sigcontext-floating-point-modes-sse2 + (alien:sap-alien scp (* unix:sigcontext)) + (logandc2 sse2-modes trap-bit))))))) (macrolet ((with-float-traps (name merge-traps docstring) ===================================== src/code/x86-vm.lisp ===================================== @@ -378,6 +378,41 @@ (defsetf sigcontext-floating-point-modes %set-sigcontext-floating-point-modes) +#+solaris +(progn +(defun sigcontext-floating-point-modes-x87 (scp) + (declare (type (alien (* unix:sigcontext)) scp)) + (let ((fn (extern-alien "os_sigcontext_x87_modes" + (function (integer 32) + (* unix:sigcontext))))) + (alien-funcall fn scp))) + +(defun %set-sigcontext-floating-point-modes-x87 (scp new-modes) + (declare (type (alien (* unix:sigcontext)) scp)) + (let ((fn (extern-alien "os_set_sigcontext_x87_modes" + (function c-call:void + (* unix:sigcontext) + c-call:unsigned-int)))) + (alien-funcall fn scp new-modes) + new-modes)) + +(defun sigcontext-floating-point-modes-sse2 (scp) + (declare (type (alien (* unix:sigcontext)) scp)) + (let ((fn (extern-alien "os_sigcontext_sse2_modes" + (function (integer 32) + (* unix:sigcontext))))) + (alien-funcall fn scp))) + +(defun %set-sigcontext-floating-point-modes-sse2 (scp new-modes) + (declare (type (alien (* unix:sigcontext)) scp)) + (let ((fn (extern-alien "os_set_sigcontext_sse2_modes" + (function c-call:void + (* unix:sigcontext) + c-call:unsigned-int)))) + (alien-funcall fn scp new-modes) + new-modes)) +) + ;;; EXTERN-ALIEN-NAME -- interface. ;;; ===================================== src/lisp/solaris-os.c ===================================== @@ -615,9 +615,9 @@ os_sigcontext_fpu_modes(ucontext_t *scp) modes = ((cw & 0x3f) << 7) | (sw & 0x3f); - DPRINTF(0, (stderr, "cw = 0x%04x\n", cw)); - DPRINTF(0, (stderr, "sw = 0x%04x\n", sw)); - DPRINTF(0, (stderr, "modes = 0x%08x\n", modes)); + DPRINTF(0, (stderr, "os_sigcontext_fpu cw = 0x%04x\n", cw)); + DPRINTF(0, (stderr, "os_sigcontext_fpu sw = 0x%04x\n", sw)); + DPRINTF(0, (stderr, "os_sigcontext_fpu modes = 0x%08x\n", modes)); #ifdef FEATURE_SSE2 /* @@ -627,7 +627,7 @@ os_sigcontext_fpu_modes(ucontext_t *scp) unsigned long mxcsr; mxcsr = fpr->fp_reg_set.fpchip_state.mxcsr; - DPRINTF(0, (stderr, "SSE2 modes = %08lx\n", mxcsr)); + DPRINTF(0, (stderr, "os_sigcontext_fpu SSE2 modes = %08lx\n", mxcsr)); modes |= mxcsr; } @@ -637,6 +637,65 @@ os_sigcontext_fpu_modes(ucontext_t *scp) return modes; } +unsigned int +os_sigcontext_x87_modes(ucontext_t *scp) +{ + unsigned short cw, sw; + fpregset_t *fpr; + fpr = &scp->uc_mcontext.fpregs; + + cw = fpr->fp_reg_set.fpchip_state.state[0] & 0xffff; + sw = fpr->fp_reg_set.fpchip_state.state[1] & 0xffff; + + DPRINTF(1, (stderr, "os_sigcontext_x87 cw, sw = #x%04x #x%04x\n", cw, sw)); + + return (cw << 16) | sw; +} + +void +os_set_sigcontext_x87_modes(ucontext_t *scp, unsigned int modes) +{ + unsigned short cw, sw; + fpregset_t *fpr; + fpr = &scp->uc_mcontext.fpregs; + + sw = modes & 0xffff; + cw = (modes >> 16) & 0xffff; + + fpr->fp_reg_set.fpchip_state.state[0] = cw; + fpr->fp_reg_set.fpchip_state.state[1] = sw; + + DPRINTF(1, (stderr, "os_set_sigcontext_x87 modes = #x%08x\n", modes)); + DPRINTF(1, (stderr, "os_set_sigcontext_x87 cw, sw = #x%04x #x%04x\n", cw, sw)); +} + + +#ifdef FEATURE_SSE2 +unsigned int +os_sigcontext_sse2_modes(ucontext_t *scp) +{ + unsigned long mxcsr; + fpregset_t *fpr; + + fpr = &scp->uc_mcontext.fpregs; + mxcsr = fpr->fp_reg_set.fpchip_state.mxcsr; + DPRINTF(1, (stderr, "os_sigcontext_sse2 mxcsr = #x%08lx\n", mxcsr)); + + return mxcsr; +} + +void +os_set_sigcontext_sse2_modes(ucontext_t *scp, unsigned int modes) +{ + fpregset_t *fpr; + fpr = &scp->uc_mcontext.fpregs; + + fpr->fp_reg_set.fpchip_state.mxcsr = modes; + + DPRINTF(1, (stderr, "os_set_sigcontext_sse2 mxcsr = #x%08x\n", modes)); +} +#endif + unsigned int os_set_sigcontext_fpu_modes(ucontext_t *scp, uint32_t modes) { View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/959faae166c9f9df7bf448f… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/959faae166c9f9df7bf448f… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-355-solaris-x86-fp-trap-handler] Use os_set_sigcontext_fpu_modes to reset modes
by Raymond Toy (＠rtoy) 29 Aug '24

29 Aug '24

Raymond Toy pushed to branch issue-355-solaris-x86-fp-trap-handler at cmucl / cmucl Commits: 4f48c6cb by Raymond Toy at 2024-08-29T07:36:36-07:00 Use os_set_sigcontext_fpu_modes to reset modes x86-vm.lisp defines `(setf sigcontext-floating-point-modes)` to set the modes in the sigcontext. Use this in `sigfpe-handler` to reset trap bit for the exception that was signaled. However, there's no implementation of `os_set_sigcontext_fpu_modes`, so implement one in solaris-os.c. Works somewhat better than before in that we don't resignal the exception again when we restart. But still have problems with divide by zero and invalid. And we're left in a weird FP trap state where we can't read 1d300 anymore---an overflow? - - - - - 2 changed files: - src/code/float-trap.lisp - src/lisp/solaris-os.c Changes: ===================================== src/code/float-trap.lisp ===================================== @@ -481,6 +481,7 @@ (type system-area-pointer scp)) (let* ((modes (sigcontext-floating-point-modes (alien:sap-alien scp (* unix:sigcontext))))) + (format t "Current modes: ~32,'0b~%" modes) (multiple-value-bind (fop operands) (let ((sym (find-symbol "GET-FP-OPERANDS" "VM"))) (if (fboundp sym) @@ -503,6 +504,7 @@ ;; ;; Clear out the status for any enabled traps. If we don't ;; then when we return, the exception gets signaled again. + #+nil (let* ((trap-bit (third (assoc code +fpe-code-info-alist+))) (current-x87-modes (vm::x87-floating-point-modes)) (current-sse2-modes (vm::sse2-floating-point-modes)) @@ -525,7 +527,16 @@ (setf (vm::x87-floating-point-modes) new-x87-modes)) (format t "new x87 modes: ~32,'0b~%" (vm::x87-floating-point-modes)) - (format t "new sse2 modes: ~32,'0b~%" (vm::sse2-floating-point-modes))))))) + (format t "new sse2 modes: ~32,'0b~%" (vm::sse2-floating-point-modes))) + (let* ((trap-bit (third (assoc code +fpe-code-info-alist+))) + (new-modes + (dpb (logandc2 (ldb float-exceptions-byte modes) + trap-bit) + float-exceptions-byte modes))) + (format t "New modes: ~32,'0b~%" new-modes) + (setf (sigcontext-floating-point-modes) + (alien:sap-alien scp (* unix:sigcontext)) + new-modes)))))) (macrolet ((with-float-traps (name merge-traps docstring) ===================================== src/lisp/solaris-os.c ===================================== @@ -637,6 +637,45 @@ os_sigcontext_fpu_modes(ucontext_t *scp) return modes; } +unsigned int +os_set_sigcontext_fpu_modes(ucontext_t *scp, uint32_t modes) +{ + unsigned short cw, sw; + fpregset_t *fpr; + unsigned int state; + + fpr = &scp->uc_mcontext.fpregs; + + cw = modes & 0x3f; + sw = (modes >> 7) &0x3f; + + DPRINTF(1, (stderr, "modes = 0x%08x\n", modes)); + DPRINTF(1, (stderr, "cw = 0x%04x\n", cw)); + DPRINTF(1, (stderr, "sw = 0x%04x\n", sw)); + + fpr->fp_reg_set.fpchip_state.state[0] = cw; + fpr->fp_reg_set.fpchip_state.state[1] = sw; + +#ifdef FEATURE_SSE2 + /* + * Add in the SSE2 part, if we're running the sse2 core. + */ + if (fpu_mode == SSE2) { + unsigned long mxcsr = modes & 0xffff; + + DPRINTF(1, (stderr, "SSE2 modes = %08lx\n", mxcsr)); + fpr->fp_reg_set.fpchip_state.mxcsr = mxcsr; + + modes |= mxcsr; + } +#endif + + modes ^= (0x3f << 7); + return modes; +} + + + boolean os_support_sse2() { View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/4f48c6cb2fb01b3613c16d5… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/4f48c6cb2fb01b3613c16d5… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-355-solaris-x86-fp-trap-handler] 2 commits: Ignore errors when setting the modes and more cleanups
by Raymond Toy (＠rtoy) 29 Aug '24

29 Aug '24

Raymond Toy pushed to branch issue-355-solaris-x86-fp-trap-handler at cmucl / cmucl Commits: a1a6bf10 by Raymond Toy at 2024-08-29T06:18:10-07:00 Ignore errors when setting the modes and more cleanups When resetting the mode bits ignore any errors that might happen if some traps are still enabled. Also, only update the exception part of the mode bits. Document what FPE_FLTSUB means. Make a note that the fpe code info alist only contains the relevant info for FP traps that we're interested in handling. With this change, an overflow and underflow are signaled as expected and when we restart, we don't get signaled again. But according to the debugging prints, we do enter the sigfpe handler twice. Divide by zero is not handled correctly, though. More testing needed. - - - - - 46e1190c by Raymond Toy at 2024-08-29T06:48:03-07:00 Refactor cleanup of handler a bit Make debugging prints line up neatly. Add vars to hold the new modes so there's less duplication in debugging prints. Remove old code about clearing out the traps which we've replaced. - - - - - 1 changed file: - src/code/float-trap.lisp Changes: ===================================== src/code/float-trap.lisp ===================================== @@ -450,11 +450,15 @@ "Signal code for FP inexact result") (defconstant +fpe-fltinv+ 7 "Signal code for FP invalid operation") - ;; Not sure what this means. + ;; On FreeBSD (and maybe other OSes), this happens when the x86 + ;; BOUND instruction detects an index out of bounds. Linux + ;; apparently generates a SIGSEGV instead. See + ;; https://stackoverflow.com/questions/27051428/what-is-a-fpe-fltsub-subscript… (defconstant +fpe-fltsub+ 8 "Signal code for subscript out of range") (defconstant +fpe-fltden+ 9 "Signal code for FP denormalize") + ;; We only include the values that FP operations can trap on. (defconstant +fpe-code-info-alist+ (list (cons +fpe-fltdiv+ (list 'division-by-zero float-divide-by-zero-trap-bit )) @@ -489,50 +493,39 @@ ;; This means we need to restore the fpu state ourselves. (unwind-protect (let ((fpe-info (second (assoc code +fpe-code-info-alist+)))) + (format t "fpe code = ~D~%" code) (if fpe-info (error fpe-info :operation fop :operands operands) (error _"SIGFPE code ~D not handled" code))) ;; Cleanup + ;; + ;; Clear out the status for any enabled traps. If we don't + ;; then when we return, the exception gets signaled again. (let* ((trap-bit (third (assoc code +fpe-code-info-alist+))) - (new-x87-modes (vm::x87-floating-point-modes)) - (new-sse2-modes (vm::sse2-floating-point-modes))) + (current-x87-modes (vm::x87-floating-point-modes)) + (current-sse2-modes (vm::sse2-floating-point-modes)) + (new-x87-modes + (dpb (logandc2 (ldb float-exceptions-byte current-sse2-modes) + trap-bit) + float-exceptions-byte current-sse2-modes)) + (new-sse2-modes + (dpb (logandc2 (ldb float-exceptions-byte current-x87-modes) + trap-bit) + float-exceptions-byte current-x87-modes))) (format t "Trap bit: ~D~%" trap-bit) - (format t "Current modes: ~16,'0b~%" (vm::floating-point-modes)) - (format t "Current x87 modes: ~16,'0b~%" new-x87-modes) - (format t "Current sse2 modes: ~16,'0b~%" new-sse2-modes) - (format t "Setting sse2 modes to: ~16,'0b~%" - (logandc2 (ldb float-exceptions-byte new-sse2-modes) - trap-bit)) - (setf (vm::sse2-floating-point-modes) - (logandc2 (ldb float-exceptions-byte new-sse2-modes) - trap-bit)) - (format t "Setting x87 modes to: ~16,'0b~%" - (logandc2 (ldb float-exceptions-byte new-x87-modes) - trap-bit)) - (setf (vm::x87-floating-point-modes) - (logandc2 (ldb float-exceptions-byte new-x87-modes) - trap-bit)) - - (format t "new x87 modes: ~16,'0b~%" (vm::x87-floating-point-modes)) - (format t "new sse2 modes: ~16,'0b~%" (vm::sse2-floating-point-modes)) - #+nil - (progn - ;; Clear out the status for any enabled traps. With SSE2, if - ;; the current exception is enabled, the next FP instruction - ;; will cause the exception to be signaled again. Hence, we - ;; need to clear out the exceptions that we are handling here. - (setf (ldb float-exceptions-byte new-modes) new-exceptions) - ;;#+nil - (progn - (format *debug-io* "sigcontext modes: #x~4x (~A)~%" - modes (decode-floating-point-modes modes)) - (format *debug-io* "current modes: #x~4x (~A)~%" - (vm:floating-point-modes) (get-floating-point-modes)) - (format *debug-io* "new modes: #x~x (~A)~%" - new-modes (decode-floating-point-modes new-modes))) - (setf (vm:floating-point-modes) new-modes))))))) + (format t "Current modes: ~32,'0b~%" (vm::floating-point-modes)) + (format t "Current x87 modes: ~32,'0b~%" current-x87-modes) + (format t "Current sse2 modes: ~32,'0b~%" current-sse2-modes) + (format t "Setting sse2 modes to: ~32,'0b~%" new-x87-modes) + (format t "Setting x87 modes to: ~32,'0b~%" new-sse2-modes) + (ignore-errors + (setf (vm::sse2-floating-point-modes) new-sse2-modes) + (setf (vm::x87-floating-point-modes) new-x87-modes)) + + (format t "new x87 modes: ~32,'0b~%" (vm::x87-floating-point-modes)) + (format t "new sse2 modes: ~32,'0b~%" (vm::sse2-floating-point-modes))))))) (macrolet ((with-float-traps (name merge-traps docstring) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/649d84d625d2d673d63685… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/649d84d625d2d673d63685… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-355-solaris-x86-fp-trap-handler] Refactor to make it simpler and more debugging.
by Raymond Toy (＠rtoy) 29 Aug '24

29 Aug '24

Raymond Toy pushed to branch issue-355-solaris-x86-fp-trap-handler at cmucl / cmucl Commits: 649d84d6 by Raymond Toy at 2024-08-28T17:14:14-07:00 Refactor to make it simpler and more debugging. Create an alist to map the Solaris FPE codes to a Lisp error type and the corresponding trap bit in the mode value. Add more debugging code and prints. We extract the x87 and sse2 modes separately so we can see what's going on. - - - - - 1 changed file: - src/code/float-trap.lisp Changes: ===================================== src/code/float-trap.lisp ===================================== @@ -454,7 +454,22 @@ (defconstant +fpe-fltsub+ 8 "Signal code for subscript out of range") (defconstant +fpe-fltden+ 9 - "Signal code for FP denormalize")) + "Signal code for FP denormalize") + (defconstant +fpe-code-info-alist+ + (list (cons +fpe-fltdiv+ + (list 'division-by-zero float-divide-by-zero-trap-bit )) + (cons +fpe-fltovf+ + (list 'floating-point-overflow float-overflow-trap-bit)) + (cons +fpe-fltund+ + (list 'floating-point-underflow float-underflow-trap-bit)) + (cons +fpe-fltres+ + (list 'floating-point-inexact float-inexact-trap-bit)) + (cons +fpe-fltinv+ + (list 'floating-point-invalid-operation float-invalid-trap-bit)) + (cons +fpe-fltden+ + (list 'floating-point-denormal-operand float-denormal-trap-bit))) + "Alist mapping the FPE code to a list of the corresponding floating + point error type and the correstrap bit value")) #+(and solaris x86) (defun sigfpe-handler (signal code scp) @@ -473,40 +488,36 @@ ;; from the signal handler so the sigcontext is never restored. ;; This means we need to restore the fpu state ourselves. (unwind-protect - (cond - ((= code +fpe-fltdiv+) - (error 'division-by-zero - :operation fop - :operands operands)) - ((= code +fpe-fltovf+) - (error 'floating-point-overflow - :operation fop - :operands operands)) - ((= code +fpe-fltund+) - (error 'floating-point-underflow - :operation fop - :operands operands)) - ((= code +fpe-fltres+) - (error 'floating-point-inexact - :operation fop - :operands operands)) - ((= code +fpe-fltinv+) - (error 'floating-point-invalid-operation - :operation fop - :operands operands)) - ((= code +fpe-fltden+) - (error 'floating-point-denormal-operand - :operation fop - :operands operands)) - (t - (error _"SIGFPE code ~D not handled" code))) + (let ((fpe-info (second (assoc code +fpe-code-info-alist+)))) + (if fpe-info + (error fpe-info + :operation fop + :operands operands) + (error _"SIGFPE code ~D not handled" code))) ;; Cleanup - (let* ((traps (logand (ldb float-exceptions-byte modes) - (ldb float-traps-byte modes))) - (new-modes modes) - (new-exceptions (logandc2 (ldb float-exceptions-byte new-modes) - traps))) - #+sse2 + (let* ((trap-bit (third (assoc code +fpe-code-info-alist+))) + (new-x87-modes (vm::x87-floating-point-modes)) + (new-sse2-modes (vm::sse2-floating-point-modes))) + (format t "Trap bit: ~D~%" trap-bit) + (format t "Current modes: ~16,'0b~%" (vm::floating-point-modes)) + (format t "Current x87 modes: ~16,'0b~%" new-x87-modes) + (format t "Current sse2 modes: ~16,'0b~%" new-sse2-modes) + (format t "Setting sse2 modes to: ~16,'0b~%" + (logandc2 (ldb float-exceptions-byte new-sse2-modes) + trap-bit)) + (setf (vm::sse2-floating-point-modes) + (logandc2 (ldb float-exceptions-byte new-sse2-modes) + trap-bit)) + (format t "Setting x87 modes to: ~16,'0b~%" + (logandc2 (ldb float-exceptions-byte new-x87-modes) + trap-bit)) + (setf (vm::x87-floating-point-modes) + (logandc2 (ldb float-exceptions-byte new-x87-modes) + trap-bit)) + + (format t "new x87 modes: ~16,'0b~%" (vm::x87-floating-point-modes)) + (format t "new sse2 modes: ~16,'0b~%" (vm::sse2-floating-point-modes)) + #+nil (progn ;; Clear out the status for any enabled traps. With SSE2, if ;; the current exception is enabled, the next FP instruction View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/649d84d625d2d673d63685f… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/649d84d625d2d673d63685f… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-355-solaris-x86-fp-trap-handler] 3 commits: Revert "Fix a reader-conditional and add comments."
by Raymond Toy (＠rtoy) 28 Aug '24

28 Aug '24

Raymond Toy pushed to branch issue-355-solaris-x86-fp-trap-handler at cmucl / cmucl Commits: 90296b78 by Raymond Toy at 2024-08-28T14:53:40-07:00 Revert "Fix a reader-conditional and add comments." This reverts commit 90b41bd331fc3260dee9bf0316b4c4a1fc35449d. - - - - - 33ea1d99 by Raymond Toy at 2024-08-28T14:54:02-07:00 Revert "For Solaris/x86, just use the sse2 mode bits." This reverts commit 72af1c16346f042bf8d04e1aa0e9b2bd52276895. - - - - - 15d7b1df by Raymond Toy at 2024-08-28T14:57:11-07:00 Minor cleanup of sigfpe-handler Move computation of `traps` farther down in the function since we don't need `traps` so early. - - - - - 1 changed file: - src/code/float-trap.lisp Changes: ===================================== src/code/float-trap.lisp ===================================== @@ -92,7 +92,7 @@ (setf (x87-floating-point-modes) x87-modes))) ) -#+(and sse2 (not (or solaris darwin))) +#+(and sse2 (not darwin)) (progn (defun floating-point-modes () ;; Combine the modes from the FPU and SSE2 units. Since the sse @@ -126,10 +126,7 @@ new-mode) ) -;; For Darwin and Solaris/x86, only diddle the SSE2 mode bits. Darwin -;; doesn't use x87. Not sure about Solaris/x86, but this works better -;; than mixing the x87 and sse2 mode bits. -#+(and sse2 (or solaris darwin)) +#+(and sse2 darwin) (progn (defun floating-point-modes () ;; Get just the SSE2 mode bits. @@ -459,19 +456,12 @@ (defconstant +fpe-fltden+ 9 "Signal code for FP denormalize")) -;; SIGFPE handler for Solaris/x86. For this OS, the CODE contains the -;; information about what caused the SIGFPE signal, so use that to -;; determine the reason for the SIGFPE. #+(and solaris x86) (defun sigfpe-handler (signal code scp) (declare (ignore signal) (type system-area-pointer scp)) (let* ((modes (sigcontext-floating-point-modes - (alien:sap-alien scp (* unix:sigcontext)))) - (traps (logand (ldb float-exceptions-byte modes) - (ldb float-traps-byte modes)))) - - + (alien:sap-alien scp (* unix:sigcontext))))) (multiple-value-bind (fop operands) (let ((sym (find-symbol "GET-FP-OPERANDS" "VM"))) (if (fboundp sym) @@ -511,7 +501,9 @@ (t (error _"SIGFPE code ~D not handled" code))) ;; Cleanup - (let* ((new-modes modes) + (let* ((traps (logand (ldb float-exceptions-byte modes) + (ldb float-traps-byte modes))) + (new-modes modes) (new-exceptions (logandc2 (ldb float-exceptions-byte new-modes) traps))) #+sse2 @@ -521,7 +513,7 @@ ;; will cause the exception to be signaled again. Hence, we ;; need to clear out the exceptions that we are handling here. (setf (ldb float-exceptions-byte new-modes) new-exceptions) - #+nil + ;;#+nil (progn (format *debug-io* "sigcontext modes: #x~4x (~A)~%" modes (decode-floating-point-modes modes)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/90b41bd331fc3260dee9bf… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/90b41bd331fc3260dee9bf… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-355-solaris-x86-fp-trap-handler] 3 commits: Oops. Change `case` to `cond`
by Raymond Toy (＠rtoy) 28 Aug '24

28 Aug '24

Raymond Toy pushed to branch issue-355-solaris-x86-fp-trap-handler at cmucl / cmucl Commits: 6e8d4939 by Raymond Toy at 2024-08-28T07:32:02-07:00 Oops. Change `case` to `cond` Forgot that `case` works with symbols, not numbers. Use `cond` instead. Also enable the debugging print, for now. - - - - - 72af1c16 by Raymond Toy at 2024-08-28T08:38:53-07:00 For Solaris/x86, just use the sse2 mode bits. Do the same as darwin and only use the sse2 mode bits when setting and getting the floating point modes. This takes care of the case when trying to restart after doing `(* 1d300 1d300)`. This used to signal the overflow again. Now it doesn't. - - - - - 90b41bd3 by Raymond Toy at 2024-08-28T08:44:46-07:00 Fix a reader-conditional and add comments. Also comment out debugging prints. - - - - - 1 changed file: - src/code/float-trap.lisp Changes: ===================================== src/code/float-trap.lisp ===================================== @@ -92,7 +92,7 @@ (setf (x87-floating-point-modes) x87-modes))) ) -#+(and sse2 (not darwin)) +#+(and sse2 (not (or solaris darwin))) (progn (defun floating-point-modes () ;; Combine the modes from the FPU and SSE2 units. Since the sse @@ -126,7 +126,10 @@ new-mode) ) -#+(and sse2 darwin) +;; For Darwin and Solaris/x86, only diddle the SSE2 mode bits. Darwin +;; doesn't use x87. Not sure about Solaris/x86, but this works better +;; than mixing the x87 and sse2 mode bits. +#+(and sse2 (or solaris darwin)) (progn (defun floating-point-modes () ;; Get just the SSE2 mode bits. @@ -456,6 +459,9 @@ (defconstant +fpe-fltden+ 9 "Signal code for FP denormalize")) +;; SIGFPE handler for Solaris/x86. For this OS, the CODE contains the +;; information about what caused the SIGFPE signal, so use that to +;; determine the reason for the SIGFPE. #+(and solaris x86) (defun sigfpe-handler (signal code scp) (declare (ignore signal) @@ -477,28 +483,28 @@ ;; from the signal handler so the sigcontext is never restored. ;; This means we need to restore the fpu state ourselves. (unwind-protect - (case code - (+fpe-fltdiv+ + (cond + ((= code +fpe-fltdiv+) (error 'division-by-zero :operation fop :operands operands)) - (+fpe-fltovf+ + ((= code +fpe-fltovf+) (error 'floating-point-overflow :operation fop :operands operands)) - (+fpe-fltund+ + ((= code +fpe-fltund+) (error 'floating-point-underflow :operation fop :operands operands)) - (+fpe-fltres+ + ((= code +fpe-fltres+) (error 'floating-point-inexact :operation fop :operands operands)) - (+fpe-fltinv+ + ((= code +fpe-fltinv+) (error 'floating-point-invalid-operation :operation fop :operands operands)) - (+fpe-fltden+ + ((= code +fpe-fltden+) (error 'floating-point-denormal-operand :operation fop :operands operands)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/f5f65ff51a6afb81fd5c97… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/f5f65ff51a6afb81fd5c97… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0