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

[Git][cmucl/cmucl][issue-130-file-author-in-c] Some debugging prints in os_file_author
by Raymond Toy (＠rtoy) 31 Aug '22

31 Aug '22

Raymond Toy pushed to branch issue-130-file-author-in-c at cmucl / cmucl Commits: 399b8755 by Raymond Toy at 2022-08-31T12:47:39-07:00 Some debugging prints in os_file_author When running CI on linux, there's a SIGABRT: ``` ISSUE.127: 1 assertions passed, 0 failed. buf2 = 0x807e500, size 1024 malloc(): invalid next size (unsorted) | Execution error: | Error in function UNIX::SIGABRT-HANDLER: SIGABRT at #xF7FC6559. | ISSUE.130: 1 assertions passed, 0 failed, and an execution error. ``` But I don't have this problem running on the same linux box. So I have to do this the hard way using CI and prints to figure it out. - - - - - 1 changed file: - src/lisp/os-common.c Changes: ===================================== src/lisp/os-common.c ===================================== @@ -783,13 +783,20 @@ os_file_author(const char *path) } if (result) { + fprintf(stderr, "Allocate %d bytes for author\n", + strlen(result->pw_name + 1)); + author = malloc(strlen(result->pw_name + 1)); if (author) { + fprintf(stderr, "author = %p\n", author); strcpy(author, result->pw_name); } } - free(buf); + fprintf(stderr, "Free buf %p\n", buf); + if (buf) { + free(buf); + } return author; } View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/399b87553f410ad600ab381… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/399b87553f410ad600ab381… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-130-file-author-in-c] Add some test for file-author
by Raymond Toy (＠rtoy) 31 Aug '22

31 Aug '22

Raymond Toy pushed to branch issue-130-file-author-in-c at cmucl / cmucl Commits: 3de2409f by Raymond Toy at 2022-08-31T08:59:18-07:00 Add some test for file-author In particular, check that (file-author ".") returns a non-NIL value. (The first implementation failed this test because the unix-namestring was "" instead of ".") Also add a simple test for a non-ascii file name name in the file "tests/안녕하십니까.txt" ("Hello" in Korean). This should not fail. - - - - - 2 changed files: - tests/issues.lisp - + tests/안녕하십니까.txt Changes: ===================================== tests/issues.lisp ===================================== @@ -579,3 +579,11 @@ with user-info = (unix:unix-getpwuid uid) while user-info finally (assert-false user-info))) + +(define-test issue.130 + (:tag :issues) + ;; Just verify that file-author works. In particular "." should + ;; work and not return NIL. + (assert-true (file-author ".")) + (assert-true (file-author "bin/build.sh")) + (assert-true (file-author "tests/안녕하십니까.txt"))) ===================================== tests/안녕하십니까.txt ===================================== @@ -0,0 +1,3 @@ +The file name of this file is "안녕하십니까.txt" ("Hello" in Korean.) + + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/3de2409f2e4921ee7de6b8f… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/3de2409f2e4921ee7de6b8f… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-120-software-type-in-c] Move software-version to misc.lisp
by Raymond Toy (＠rtoy) 31 Aug '22

31 Aug '22

Raymond Toy pushed to branch issue-120-software-type-in-c at cmucl / cmucl Commits: 6f25328f by Raymond Toy at 2022-08-31T08:20:55-07:00 Move software-version to misc.lisp The version in misc.lisp can handle all OSes, so remove the different implementations in the foo-os.lisp files in favor of the one in misc.lisp. - - - - - 4 changed files: - src/code/bsd-os.lisp - src/code/linux-os.lisp - src/code/misc.lisp - src/code/sunos-os.lisp Changes: ===================================== src/code/bsd-os.lisp ===================================== @@ -42,32 +42,13 @@ #+executable (register-lisp-runtime-feature :executable) -#+nil -(setq *software-type* #+OpenBSD "OpenBSD" - #+NetBSD "NetBSD" - #+freebsd "FreeBSD" - #+Darwin "Darwin" - #-(or freebsd NetBSD OpenBSD Darwin) "BSD") - -(defvar *software-version* nil "Version string for supporting software") - -(defun software-version () - "Returns a string describing version of the supporting software." - (unless *software-version* - (setf *software-version* - (string-trim '(#\newline) - (with-output-to-string (stream) - (run-program "/usr/bin/uname" - '("-r") - :output stream))))) - *software-version*) - ;;; OS-Init initializes our operating-system interface. It sets the values ;;; of the global port variables to what they should be and calls the functions ;;; that set up the argument blocks for the server interfaces. (defun os-init () + ;; Decache version on save, because it might not be the same when we restart. (setf *software-version* nil)) ;;; GET-SYSTEM-INFO -- Interface ===================================== src/code/linux-os.lisp ===================================== @@ -26,46 +26,11 @@ (register-lisp-feature :elf) (register-lisp-runtime-feature :executable) -;;(setq *software-type* "Linux") - -(defvar *software-version* nil - "Version string for supporting software") - -;;; Instead of reading /proc/version (which has some bugs with -;;; select() in Linux kernel 2.6.x) and instead of running uname -r, -;;; let's just get the info from uname(). -(defun software-version () - "Returns a string describing version of the supporting software." - (unless *software-version* - (setf *software-version* - (multiple-value-bind (sysname nodename release version) - (unix:unix-uname) - (declare (ignore sysname nodename)) - (concatenate 'string release " " version)))) - *software-version*) - -#+nil -(defun software-version () - "Returns a string describing version of the supporting software." - (unless *software-version* - (setf *software-version* - (let (version) - (unwind-protect - (progn - (setf version - (alien:alien-funcall - (alien:extern-alien "os_software_version" - (function (alien:* c-call:c-string))))) - (unless (zerop (sap-int (alien:alien-sap version))) - (alien:cast version c-call:c-string))) - (when version - (alien:free-alien version))))) - *software-version*)) - - ;;; OS-Init initializes our operating-system interface. ;;; -(defun os-init () nil) +(defun os-init () + ;; Decache version on save, because it might not be the same when we restart. + (setf *software-version* nil)) ;;; GET-SYSTEM-INFO -- Interface ===================================== src/code/misc.lisp ===================================== @@ -204,6 +204,26 @@ (alien:free-alien software-type)))))) *software-type*) +(defvar *software-version* nil + _N"Version string for supporting software") + +(defun software-version () + _N"Returns a string describing version of the supporting software." + (unless *software-version* + (setf *software-version* + (let (version) + (unwind-protect + (progn + (setf version + (alien:alien-funcall + (alien:extern-alien "os_software_version" + (function (alien:* c-call:c-string))))) + (unless (zerop (sap-int (alien:alien-sap version))) + (alien:cast version c-call:c-string))) + (when version + (alien:free-alien version))))) + *software-version*)) + (defvar *short-site-name* (intl:gettext "Unknown") "The value of SHORT-SITE-NAME. Set in library:site-init.lisp.") ===================================== src/code/sunos-os.lisp ===================================== @@ -31,21 +31,6 @@ #+executable (register-lisp-runtime-feature :executable) -;;(setq *software-type* "SunOS") - -(defvar *software-version* nil "Version string for supporting software") - -(defun software-version () - "Returns a string describing version of the supporting software." - (unless *software-version* - (setf *software-version* - (multiple-value-bind (sysname nodename release version) - (unix:unix-uname) - (declare (ignore sysname nodename)) - (concatenate 'string release " " version)))) - *software-version*) - - ;;; OS-INIT -- interface. ;;; ;;; Other OS dependent initializations. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6f25328fd2f67d8119ff3b7… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6f25328fd2f67d8119ff3b7… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-120-software-type-in-c] Don't set *software-type* in sunos-os.lisp
by Raymond Toy (＠rtoy) 31 Aug '22

31 Aug '22

Raymond Toy pushed to branch issue-120-software-type-in-c at cmucl / cmucl Commits: 882fa7ec by Raymond Toy at 2022-08-31T08:06:20-07:00 Don't set *software-type* in sunos-os.lisp - - - - - 1 changed file: - src/code/sunos-os.lisp Changes: ===================================== src/code/sunos-os.lisp ===================================== @@ -31,7 +31,7 @@ #+executable (register-lisp-runtime-feature :executable) -(setq *software-type* "SunOS") +;;(setq *software-type* "SunOS") (defvar *software-version* nil "Version string for supporting software") View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/882fa7ec9609cfdd01b08a7… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/882fa7ec9609cfdd01b08a7… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][set-secret-detection-config-1] Configure Secret Detection in `.gitlab-ci.yml`, creating this file if it does not already exist
by Raymond Toy (＠rtoy) 31 Aug '22

31 Aug '22

Raymond Toy pushed to branch set-secret-detection-config-1 at cmucl / cmucl Commits: f4c350c4 by Raymond Toy at 2022-08-31T01:54:33+00:00 Configure Secret Detection in `.gitlab-ci.yml`, creating this file if it does not already exist - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1,188 +1,167 @@ +# You can override the included template(s) by including variable overrides +# SAST customization: https://docs.gitlab.com/ee/user/application_security/sast/#customizing-the-… +# Secret Detection customization: https://docs.gitlab.com/ee/user/application_security/secret_detection/#cust… +# Dependency Scanning customization: https://docs.gitlab.com/ee/user/application_security/dependency_scanning/#c… +# Note that environment variables can be set in several places +# See https://docs.gitlab.com/ee/ci/variables/#cicd-variable-precedence variables: - download_url: "https://common-lisp.net/project/cmucl/downloads/snapshots/2021/07" - version: "2021-07-x86" - bootstrap: "" - + download_url: https://common-lisp.net/project/cmucl/downloads/snapshots/2021/07 + version: 2021-07-x86 + bootstrap: '' stages: - - install - - build - - test - - ansi-test - - benchmark - -cache: - - +- install +- build +- test +- ansi-test +- benchmark +cache: linux:install: stage: install tags: - - linux + - linux artifacts: paths: - - snapshot/ + - snapshot/ script: - - wget -nv $download_url/cmucl-$version-linux.tar.bz2 - - wget -nv $download_url/cmucl-$version-linux.extra.tar.bz2 - - mkdir snapshot - - (cd snapshot; tar xjf ../cmucl-$version-linux.tar.bz2; tar xjf ../cmucl-$version-linux.extra.tar.bz2) - + - wget -nv $download_url/cmucl-$version-linux.tar.bz2 + - wget -nv $download_url/cmucl-$version-linux.extra.tar.bz2 + - mkdir snapshot + - "(cd snapshot; tar xjf ../cmucl-$version-linux.tar.bz2; tar xjf ../cmucl-$version-linux.extra.tar.bz2)" linux:build: stage: build tags: - - linux + - linux artifacts: paths: - - dist/ - - linux-2/*.log - - linux-3/*.log - - linux-4/*.log + - dist/ + - linux-2/*.log + - linux-3/*.log + - linux-4/*.log needs: - - job: linux:install - artifacts: true + - job: linux:install + artifacts: true script: - # Do cross compile first - #- bin/create-target.sh xtarget x86_linux_clang - #- bin/create-target.sh xcross x86_linux_clang - #- bin/cross-build-world.sh -crl -B boot-2020-04-1 xtarget xcross src/tools/cross-scripts/cross-x86-x86.lisp snapshot/bin/lisp - # Regular build using the cross-compiled result or snapshot - - bin/build.sh $bootstrap -R -C "x86_linux_clang" -o snapshot/bin/lisp - - bin/make-dist.sh -I dist linux-4 - + - bin/build.sh $bootstrap -R -C "x86_linux_clang" -o snapshot/bin/lisp + - bin/make-dist.sh -I dist linux-4 linux:test: stage: test tags: - - linux + - linux artifacts: paths: - - ansi-test/test.out - - test.log + - ansi-test/test.out + - test.log needs: - # Needs artifacts from build (dist/) - - job: linux:build - artifacts: true + - job: linux:build + artifacts: true script: - - bin/run-tests.sh -l dist/bin/lisp 2>&1 | tee test.log - + - bin/run-tests.sh -l dist/bin/lisp 2>&1 | tee test.log linux:ansi-test: stage: ansi-test tags: - - linux + - linux artifacts: paths: - - ansi-test/test.out + - ansi-test/test.out needs: - # Needs artifacts from build (dist/) - - job: linux:build - artifacts: true + - job: linux:build + artifacts: true before_script: - - git clone https://gitlab.common-lisp.net/cmucl/ansi-test.git - - (cd ansi-test; git checkout rtoy-cmucl-expected-failures) + - git clone https://gitlab.common-lisp.net/cmucl/ansi-test.git + - "(cd ansi-test; git checkout rtoy-cmucl-expected-failures)" script: - - cd ansi-test - - make LISP="../dist/bin/lisp -batch -noinit -nositeinit" - - grep 'No unexpected $successes\|failures$' test.out - + - cd ansi-test + - make LISP="../dist/bin/lisp -batch -noinit -nositeinit" + - grep 'No unexpected $successes\|failures$' test.out linux:benchmark: stage: benchmark tags: - - linux + - linux artifacts: paths: - - benchmarks/cl-bench/results + - benchmarks/cl-bench/results needs: - # Needs artifacts from install (snapshot/) and build (dist/) - - job: linux:install - artifacts: true - - job: linux:build + - job: linux:install + artifacts: true + - job: linux:build script: - - cd benchmarks/cl-bench - - mkdir tmp - - CMUCL=../../snapshot/bin/lisp ./run-cmucl.sh - - CMUCL=../../dist/bin/lisp ./run-cmucl.sh - - ../../snapshot/bin/lisp -load report - + - cd benchmarks/cl-bench + - mkdir tmp + - CMUCL=../../snapshot/bin/lisp ./run-cmucl.sh + - CMUCL=../../dist/bin/lisp ./run-cmucl.sh + - "../../snapshot/bin/lisp -load report" osx:install: stage: install tags: - - osx + - osx artifacts: paths: - - snapshot/ + - snapshot/ script: - - /opt/local/bin/curl -o cmucl-$version-darwin.tar.bz2 $download_url/cmucl-$version-darwin.tar.bz2 - - mkdir snapshot - - (cd snapshot; tar xjf ../cmucl-$version-darwin.tar.bz2) - + - "/opt/local/bin/curl -o cmucl-$version-darwin.tar.bz2 $download_url/cmucl-$version-darwin.tar.bz2" + - mkdir snapshot + - "(cd snapshot; tar xjf ../cmucl-$version-darwin.tar.bz2)" osx:build: stage: build tags: - - osx + - osx artifacts: paths: - - dist/ - - darwin-2/*.log - - darwin-3/*.log - - darwin-4/*.log + - dist/ + - darwin-2/*.log + - darwin-3/*.log + - darwin-4/*.log needs: - - job: osx:install - artifacts: true + - job: osx:install + artifacts: true script: - # Do cross compile first - #- bin/create-target.sh xtarget x86_darwin - #- bin/create-target.sh xcross x86_darwin - #- bin/cross-build-world.sh -crl -B boot-2020-04-1 xtarget xcross src/tools/cross-scripts/cross-x86-x86.lisp snapshot/bin/lisp - # Regular build using the cross-compiled result or snapshot - - bin/build.sh $bootstrap -R -C "" -o snapshot/bin/lisp - - bin/make-dist.sh -I dist darwin-4 - + - bin/build.sh $bootstrap -R -C "" -o snapshot/bin/lisp + - bin/make-dist.sh -I dist darwin-4 osx:test: stage: test tags: - - osx + - osx artifacts: paths: - - test.log + - test.log needs: - # Needs artifacts from build (dist/) - - job: osx:build - artifacts: true + - job: osx:build + artifacts: true script: - - bin/run-tests.sh -l dist/bin/lisp 2>&1 | tee test.log - + - bin/run-tests.sh -l dist/bin/lisp 2>&1 | tee test.log osx:ansi-test: stage: ansi-test tags: - - osx + - osx artifacts: paths: - - ansi-test/test.out + - ansi-test/test.out needs: - # Needs artifacts from build (dist/) - - job: osx:build - artifacts: true + - job: osx:build + artifacts: true before_script: - - /opt/local/bin/git clone https://gitlab.common-lisp.net/cmucl/ansi-test.git - - (cd ansi-test; /opt/local/bin/git checkout rtoy-cmucl-expected-failures) + - "/opt/local/bin/git clone https://gitlab.common-lisp.net/cmucl/ansi-test.git" + - "(cd ansi-test; /opt/local/bin/git checkout rtoy-cmucl-expected-failures)" script: - - cd ansi-test - - make LISP="../dist/bin/lisp -batch -noinit -nositeinit" - - grep 'No unexpected $successes\|failures$' test.out - + - cd ansi-test + - make LISP="../dist/bin/lisp -batch -noinit -nositeinit" + - grep 'No unexpected $successes\|failures$' test.out osx:benchmark: stage: benchmark tags: - - osx + - osx artifacts: paths: - - benchmarks/cl-bench/results + - benchmarks/cl-bench/results needs: - # Needs artifacts from install (snapshot/) and build (dist/) - - job: osx:install - artifacts: true - - job: osx:build + - job: osx:install + artifacts: true + - job: osx:build script: - - cd benchmarks/cl-bench - - mkdir tmp - - CMUCL=../../snapshot/bin/lisp ./run-cmucl.sh - - CMUCL=../../dist/bin/lisp ./run-cmucl.sh - - ../../snapshot/bin/lisp -load report + - cd benchmarks/cl-bench + - mkdir tmp + - CMUCL=../../snapshot/bin/lisp ./run-cmucl.sh + - CMUCL=../../dist/bin/lisp ./run-cmucl.sh + - "../../snapshot/bin/lisp -load report" +include: +- template: Security/Secret-Detection.gitlab-ci.yml View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/f4c350c44397cf91b4850c8… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/f4c350c44397cf91b4850c8… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch set-secret-detection-config-1
by Raymond Toy (＠rtoy) 31 Aug '22

31 Aug '22

Raymond Toy pushed new branch set-secret-detection-config-1 at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/set-secret-detection-conf… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-120-software-type-in-c] Add missing semicolon for macos
by Raymond Toy (＠rtoy) 31 Aug '22

31 Aug '22

Raymond Toy pushed to branch issue-120-software-type-in-c at cmucl / cmucl Commits: e0ecf7d2 by Raymond Toy at 2022-08-30T17:17:58-07:00 Add missing semicolon for macos - - - - - 1 changed file: - src/lisp/os-common.c Changes: ===================================== src/lisp/os-common.c ===================================== @@ -750,7 +750,7 @@ os_software_version() strcat(version, " "); strcat(version, uts.version); #else - strcpy(version, uts.version) + strcpy(version, uts.version); #endif } } View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/e0ecf7d2289535975e839b9… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/e0ecf7d2289535975e839b9… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-120-software-type-in-c] Move documentation function from misc.lisp to misc-doc.lisp
by Raymond Toy (＠rtoy) 31 Aug '22

31 Aug '22

Raymond Toy pushed to branch issue-120-software-type-in-c at cmucl / cmucl Commits: eb415b6d by Raymond Toy at 2022-08-30T17:04:01-07:00 Move documentation function from misc.lisp to misc-doc.lisp pclcom.lisp loads misc to get the documentation functions. This causes a problem when building cmucl with the new os_software_type function because it's undefined on the first build because we haven't defined it yet. To simplify things, move the documentation functions from misc.lisp to misc-doc.lisp so that pclcom can just load misc-doc to get just what is needed. This allows the build to proceed with os_software_type being undefined in the first build. - - - - - 5 changed files: - + src/code/misc-doc.lisp - src/code/misc.lisp - src/tools/pclcom.lisp - src/tools/worldbuild.lisp - src/tools/worldcom.lisp Changes: ===================================== src/code/misc-doc.lisp ===================================== @@ -0,0 +1,119 @@ +;;; -*- Mode: Lisp; Package: Lisp; Log: code.log -*- +;;; +;;; ********************************************************************** +;;; This code was written as part of the CMU Common Lisp project at +;;; Carnegie Mellon University, and has been placed in the public domain. +;;; +(ext:file-comment + "$Header: src/code/misc.lisp $") +;;; +;;; ********************************************************************** +;;; +;;; Documentation functions. Needed by pclcom.lisp +(in-package "LISP") +(intl:textdomain "cmucl") + +(export '(documentation)) + +;;; cobbled from stuff in describe.lisp. +(defun function-doc (x) + (let ((name + (case (kernel:get-type x) + (#.vm:closure-header-type + (kernel:%function-name (%closure-function x))) + ((#.vm:function-header-type #.vm:closure-function-header-type) + (kernel:%function-name x)) + (#.vm:funcallable-instance-header-type + (typecase x + (kernel:byte-function + (c::byte-function-name x)) + (kernel:byte-closure + (c::byte-function-name (byte-closure-function x))) + (eval:interpreted-function + (multiple-value-bind + (exp closure-p dname) + (eval:interpreted-function-lambda-expression x) + (declare (ignore exp closure-p)) + dname)) + (t ;; funcallable-instance + (kernel:%function-name + (kernel:funcallable-instance-function x)))))))) + (when (and name (typep name '(or symbol cons))) + (values (info function documentation name))))) + +(defun documentation (x doc-type) + "Returns the documentation string of Doc-Type for X, or NIL if + none exists. System doc-types are VARIABLE, FUNCTION, STRUCTURE, TYPE, + SETF, and T." + (flet (;; CMUCL random-documentation. + (try-cmucl-random-doc (x doc-type) + (declare (symbol doc-type)) + (cdr (assoc doc-type + (values (info random-documentation stuff x)))))) + (case doc-type + (variable + (typecase x + (symbol (values (info variable documentation x))))) + (function + (typecase x + (symbol (values (info function documentation x))) + (function (function-doc x)) + (list ;; Must be '(setf symbol) + (values (info function documentation (cadr x)))))) + (structure + (typecase x + (symbol (when (eq (info type kind x) :instance) + (values (info type documentation x)))))) + (type + (typecase x + (kernel::structure-class (values (info type documentation (%class-name x)))) + (t (and (typep x 'symbol) (values (info type documentation x)))))) + (setf (info setf documentation x)) + ((t) + (typecase x + (function (function-doc x)) + (package (package-doc-string x)) + (kernel::structure-class (values (info type documentation (%class-name x)))) + (symbol (try-cmucl-random-doc x doc-type)))) + (t + (typecase x + (symbol (try-cmucl-random-doc x doc-type))))))) + +(defun (setf documentation) (string name doc-type) + #-no-docstrings + (case doc-type + (variable + #+nil + (when string + (%primitive print "Set variable text domain") + (%primitive print (symbol-name name)) + (%primitive print intl::*default-domain*)) + (setf (info variable textdomain name) intl::*default-domain*) + (setf (info variable documentation name) string)) + (function + #+nil + (when intl::*default-domain* + (%primitive print "Set function text domain") + (%primitive print (symbol-name name)) + (%primitive print intl::*default-domain*)) + (setf (info function textdomain name) intl::*default-domain*) + (setf (info function documentation name) string)) + (structure + (unless (eq (info type kind name) :instance) + (error (intl:gettext "~S is not the name of a structure type.") name)) + (setf (info type textdomain name) intl::*default-domain*) + (setf (info type documentation name) string)) + (type + (setf (info type textdomain name) intl::*default-domain*) + (setf (info type documentation name) string)) + (setf + (setf (info setf textdomain name) intl::*default-domain*) + (setf (info setf documentation name) string)) + (t + (let ((pair (assoc doc-type (info random-documentation stuff name)))) + (if pair + (setf (cdr pair) string) + (push (cons doc-type string) + (info random-documentation stuff name)))))) + string) + ===================================== src/code/misc.lisp ===================================== @@ -17,7 +17,7 @@ (in-package "LISP") (intl:textdomain "cmucl") -(export '(documentation *features* variable room +(export '(*features* variable room lisp-implementation-type lisp-implementation-version machine-type machine-version machine-instance software-type software-version short-site-name long-site-name dribble compiler-macro)) ===================================== src/tools/pclcom.lisp ===================================== @@ -12,7 +12,7 @@ (when (find-package "PCL") ;; Load the lisp:documentation functions. - (load "target:code/misc") + (load "target:code/misc-doc") ;; ;; Blow away make-instance optimizer so that it doesn't confuse ===================================== src/tools/worldbuild.lisp ===================================== @@ -113,6 +113,7 @@ "target:code/string" "target:code/mipsstrops" "target:code/misc" + "target:code/misc-doc" "target:code/dfixnum" ,@(unless (c:backend-featurep :gengc) '("target:code/gc")) ===================================== src/tools/worldcom.lisp ===================================== @@ -211,6 +211,7 @@ (comf "target:code/unidata") (comf "target:code/char") (comf "target:code/misc") +(comf "target:code/misc-doc") (comf "target:code/extensions" :byte-compile t) (comf "target:code/commandline") (comf "target:code/env-access") View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/eb415b6d325669213ddb594… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/eb415b6d325669213ddb594… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-120-software-type-in-c] Implement software-type in C
by Raymond Toy (＠rtoy) 30 Aug '22

30 Aug '22

Raymond Toy pushed to branch issue-120-software-type-in-c at cmucl / cmucl Commits: 3c1f5538 by Raymond Toy at 2022-08-30T06:27:12-07:00 Implement software-type in C Add function software-type to misc.lisp, and initialize to *software-type* to NIL so that (software-type) will set it appropriately. Add function os_software_type to os-common.c that returns the sysname slot of struct utsname. On Linux and macos, this value matches the value that we previously returned. In linux-os.lisp and bsd-os.lisp, comment out the code that sets *software-type*. (We need to do this for other OSes, still) - - - - - 4 changed files: - src/code/bsd-os.lisp - src/code/linux-os.lisp - src/code/misc.lisp - src/lisp/os-common.c Changes: ===================================== src/code/bsd-os.lisp ===================================== @@ -42,6 +42,7 @@ #+executable (register-lisp-runtime-feature :executable) +#+nil (setq *software-type* #+OpenBSD "OpenBSD" #+NetBSD "NetBSD" #+freebsd "FreeBSD" ===================================== src/code/linux-os.lisp ===================================== @@ -26,7 +26,7 @@ (register-lisp-feature :elf) (register-lisp-runtime-feature :executable) -(setq *software-type* "Linux") +;;(setq *software-type* "Linux") (defvar *software-version* nil "Version string for supporting software") ===================================== src/code/misc.lisp ===================================== @@ -183,11 +183,25 @@ "Returns a string giving the name of the local machine." (unix:unix-gethostname)) -(defvar *software-type* "Unix" - "The value of SOFTWARE-TYPE. Set in FOO-os.lisp.") +(defvar *software-type* nil + _N"The value of SOFTWARE-TYPE.") (defun software-type () - "Returns a string describing the supporting software." + _N"Returns a string describing the supporting software." + (unless *software-type* + (setf *software-type* + (let (software-type) + ;; Get the software-type from the C function os_software_type. + (unwind-protect + (progn + (setf software-type + (alien:alien-funcall + (alien:extern-alien "os_software_type" + (function (alien:* c-call:c-string))))) + (unless (zerop (sap-int (alien:alien-sap software-type))) + (alien:cast software-type c-call:c-string))) + (when software-type + (alien:free-alien software-type)))))) *software-type*) (defvar *short-site-name* (intl:gettext "Unknown") ===================================== src/lisp/os-common.c ===================================== @@ -757,3 +757,23 @@ os_software_version() return version; } +#undef UNAME_RELEASE_AND_VERSION + +char* +os_software_type() +{ + int status; + struct utsname uts; + char *os_name = NULL; + + status = uname(&uts); + if (status == 0) { + os_name = malloc(strlen(uts.sysname) + 1); + if (os_name) { + strcpy(os_name, uts.sysname); + } + } + + return os_name; +} + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/3c1f5538b09c6256480aac2… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/3c1f5538b09c6256480aac2… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-120-software-type-in-c
by Raymond Toy (＠rtoy) 30 Aug '22

30 Aug '22

Raymond Toy pushed new branch issue-120-software-type-in-c at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-120-software-type-i… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-130-file-author-in-c] Include stdlib.h and unistd.h
by Raymond Toy (＠rtoy) 29 Aug '22

29 Aug '22

Raymond Toy pushed to branch issue-130-file-author-in-c at cmucl / cmucl Commits: ec14c5b1 by Raymond Toy at 2022-08-29T14:07:02-07:00 Include stdlib.h and unistd.h stdlib.h is needed for malloc and friends. unistd.h is needed for sysconf. - - - - - 1 changed file: - src/lisp/os-common.c Changes: ===================================== src/lisp/os-common.c ===================================== @@ -11,8 +11,10 @@ #include <pwd.h> #include <stdbool.h> #include <stdio.h> +#include <stdlib.h> #include <string.h> #include <sys/stat.h> +#include <unistd.h> #include <time.h> #include "os.h" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ec14c5b16fc37e56023f069… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ec14c5b16fc37e56023f069… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-130-file-author-in-c] Use sysconf to get buffer size and add loop to increase size
by Raymond Toy (＠rtoy) 29 Aug '22

29 Aug '22

Raymond Toy pushed to branch issue-130-file-author-in-c at cmucl / cmucl Commits: fe9fa1db by Raymond Toy at 2022-08-29T12:05:30-07:00 Use sysconf to get buffer size and add loop to increase size Use sysconf to get the buffer size. If it fails, use a default and add a loop to keep trying with a larger buffer size (until some upper limit is reached.) - - - - - 1 changed file: - src/lisp/os-common.c Changes: ===================================== src/lisp/os-common.c ===================================== @@ -9,6 +9,7 @@ #include <math.h> #include <netdb.h> #include <pwd.h> +#include <stdbool.h> #include <stdio.h> #include <string.h> #include <sys/stat.h> @@ -725,21 +726,60 @@ os_lstat(const char* path, u_int64_t *dev, u_int64_t *ino, unsigned int *mode, u char * os_file_author(const char *path) { - int rc; + int status; struct stat statbuf; - char buf[16384]; char* author = NULL; + bool nomem = false; + size_t bufsize; + char* buf = NULL; + char* buf2 = NULL; struct passwd pwd; struct passwd *result = NULL; - rc = stat(path, &statbuf); + status = stat(path, &statbuf); - if (rc != 0) { + if (status != 0) { return NULL; } - rc = getpwuid_r(statbuf.st_uid, &pwd, buf, sizeof(buf), &result); + bufsize = sysconf(_SC_GETPW_R_SIZE_MAX); + /* + * If sysconf fails, just use a small initial buffer size that we + * will keep growing up to some maximum size. + */ + if (bufsize == -1) { + bufsize = 1024; + } + + while (1) { + buf2 = realloc(buf, bufsize); + fprintf(stderr, "buf2 = %p, size %zu\n", buf2, bufsize); + + if (buf2 == NULL) { + result = NULL; + nomem = true; + break; + } + + buf = buf2; + status = getpwuid_r(statbuf.st_uid, &pwd, buf, bufsize, &result); + + if (status != 0) { + result = NULL; + } + if ((result != NULL) || (status != ERANGE)) { + break; + } + /* If bufsize exceeds some large size, give up. */ + if (bufsize > 16384) { + nomem = true; + break; + } + + bufsize <<= 1; + } + if (result) { author = malloc(strlen(result->pw_name + 1)); if (author) { @@ -747,5 +787,7 @@ os_file_author(const char *path) } } + free(buf); + return author; } View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/fe9fa1dbfdc86cd86ae4f19… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/fe9fa1dbfdc86cd86ae4f19… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-130-file-author-in-c] os_file_author returns a new string for the author
by Raymond Toy (＠rtoy) 29 Aug '22

29 Aug '22

Raymond Toy pushed to branch issue-130-file-author-in-c at cmucl / cmucl Commits: 82e485f4 by Raymond Toy at 2022-08-29T07:52:27-07:00 os_file_author returns a new string for the author Update file-author to call os_file_author correctly. - - - - - 2 changed files: - src/code/filesys.lisp - src/lisp/os-common.c Changes: ===================================== src/code/filesys.lisp ===================================== @@ -1098,16 +1098,22 @@ optionally keeping some of the most recent old versions." :pathname file :format-control (intl:gettext "~S doesn't exist.") :format-arguments (list file))) - (alien:with-alien ((author (array c-call:char 1024))) - (unix::syscall* ("os_file_author" c-call:c-string - (alien:array c-call:char 1024) - c-call:int) - ;; Return - (alien:cast author c-call:c-string) - ;; Args - (unix::%name->file name) - author - 1024))))) + ;; unix-namestring converts "." to "". Convert it back to + ;; "." so we can stat the current directory. (Perhaps + ;; that's a bug in unix-namestring?) + (when (string= name "") + (setf name ".")) + (let (author) + (unwind-protect + (progn + (setf author (alien:alien-funcall + (alien:extern-alien "os_file_author" + (function (alien:* c-call:c-string) c-call:c-string)) + (unix::%name->file name))) + (unless (zerop (sap-int (alien:alien-sap author))) + (alien:cast author c-call:c-string))) + (when author + (alien:free-alien author))))))) ;;;; DIRECTORY. ===================================== src/lisp/os-common.c ===================================== @@ -717,36 +717,35 @@ os_lstat(const char* path, u_int64_t *dev, u_int64_t *ino, unsigned int *mode, u return rc; } -int -os_file_author(const char *path, char* author, int len) +/* + * Interface for file-author. Given a pathname, returns a new string + * holding the author of the file or NULL if some error occurred. The + * caller is responsible for freeing the memory used by the string. + */ +char * +os_file_author(const char *path) { int rc; struct stat statbuf; char buf[16384]; + char* author = NULL; struct passwd pwd; - struct passwd *result; + struct passwd *result = NULL; rc = stat(path, &statbuf); if (rc != 0) { - return rc; + return NULL; } rc = getpwuid_r(statbuf.st_uid, &pwd, buf, sizeof(buf), &result); if (result) { - if (strlen(result->pw_name) < len) { + author = malloc(strlen(result->pw_name + 1)); + if (author) { strcpy(author, result->pw_name); - } else { - strcpy(author, ""); - rc = -1; } } - return rc; + return author; } - - - - - View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/82e485f4e866c2c87643a17… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/82e485f4e866c2c87643a17… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-130-file-author-in-c
by Raymond Toy (＠rtoy) 26 Aug '22

26 Aug '22

Raymond Toy pushed new branch issue-130-file-author-in-c at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-130-file-author-in-c You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Add docstring for unix:unix-uname
by Raymond Toy (＠rtoy) 24 Aug '22

24 Aug '22

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 8b9a14fc by Raymond Toy at 2022-08-23T21:39:02-07:00 Add docstring for unix:unix-uname Update pot file too since the docstring changed. No functional changes. - - - - - 2 changed files: - src/code/unix.lisp - src/i18n/locale/cmucl-unix.pot Changes: ===================================== src/code/unix.lisp ===================================== @@ -2726,6 +2726,14 @@ (domainname (array char 65)))) (defun unix-uname () + _N"Unix-uname returns information from the uname(2) system call. + The return values are + + Name of the operating system + Name of this node within some implementation-defined network, if any + Release level of this operating system + Version level of this operating system release + Name of the hardware type on which the system is running" (with-alien ((names (struct utsname))) (syscall* (#-(or freebsd (and x86 solaris)) "uname" #+(and x86 solaris) "nuname" ; See /usr/include/sys/utsname.h ===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -1365,6 +1365,18 @@ msgid "" " and its children." msgstr "" +#: src/code/unix.lisp +msgid "" +"Unix-uname returns information from the uname(2) system call.\n" +" The return values are\n" +"\n" +" Name of the operating system\n" +" Name of this node within some implementation-defined network, if any\n" +" Release level of this operating system\n" +" Version level of this operating system release\n" +" Name of the hardware type on which the system is running" +msgstr "" + #: src/code/unix.lisp msgid "" "Get the value of the environment variable named Name. If no such\n" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/8b9a14fc3a2c684a538e68a… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/8b9a14fc3a2c684a538e68a… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #125: Linux unix-stat returns wrong values
by Raymond Toy (＠rtoy) 23 Aug '22

23 Aug '22

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 171ca28b by Raymond Toy at 2022-08-23T23:01:04+00:00 Fix #125: Linux unix-stat returns wrong values - - - - - 2dfc9ff1 by Raymond Toy at 2022-08-23T23:01:09+00:00 Merge branch 'issue-125-unix-stat-wrong' into 'master' Fix #125: Linux unix-stat returns wrong values Closes #125 See merge request cmucl/cmucl!85 - - - - - 7 changed files: - src/code/unix.lisp - src/contrib/unix/unix-glibc2.lisp - src/contrib/unix/unix.lisp - src/i18n/locale/cmucl-unix.pot - src/lisp/Config.x86_linux - src/lisp/Config.x86_linux_clang - src/lisp/os-common.c Changes: ===================================== src/code/unix.lisp ===================================== @@ -53,12 +53,9 @@ (def-alien-type u-int32-t unsigned-int) (def-alien-type ino-t - #+netbsd u-int64-t + #+(or netbsd linux darwin) u-int64-t #+alpha unsigned-int - #-(or alpha netbsd) unsigned-long) - -#+linux -(def-alien-type ino64-t u-int64-t) + #-(or alpha netbsd linux darwin) unsigned-long) (def-alien-type size-t #-(or linux alpha) long @@ -72,14 +69,6 @@ #+(and bsd netbsd) int64-t #+alpha unsigned-int) -(def-alien-type dev-t - #-(or alpha svr4 bsd linux) short - #+(and linux (not amd64)) uquad-t - #+(and linux amd64) u-int64-t - #+netbsd u-int64-t - #+alpha int - #+(and (not linux) (not netbsd) (or bsd svr4)) unsigned-long) - #-BSD (progn (deftype file-offset () '(signed-byte 32)) @@ -131,13 +120,6 @@ `(multiple-value-bind (,word ,bit) (floor ,offset 32) (logbitp ,bit (deref (slot ,fd-set 'fds-bits) ,word))))) -(def-alien-type nlink-t - #-(or svr4 netbsd linux) unsigned-short - #+netbsd unsigned-long - #+svr4 unsigned-long - #+(and linux (not amd64)) unsigned-int - #+(and linux amd64) u-int64-t) - (defconstant fd-setsize #-(or hpux alpha linux FreeBSD) 256 #+hpux 2048 #+alpha 4096 #+(or linux FreeBSD) 1024) @@ -1301,7 +1283,7 @@ #+glibc2.1 (d-ino ino-t) ; inode number of entry #-glibc2.1 - (d-ino ino64-t) ; inode number of entry + (d-ino ino-t) ; inode number of entry (d-off off-t) ; offset of next disk directory entry (d-reclen unsigned-short) ; length of this record (d_type unsigned-char) @@ -1347,261 +1329,143 @@ (d-name (array char 256)))) ; name must be no longer than this -#+(and bsd (not netbsd)) -(def-alien-type nil - (struct stat - (st-dev dev-t) - (st-ino ino-t) - (st-mode mode-t) - (st-nlink nlink-t) - (st-uid uid-t) - (st-gid gid-t) - (st-rdev dev-t) - (st-atime (struct timespec-t)) - (st-mtime (struct timespec-t)) - (st-ctime (struct timespec-t)) - (st-size off-t) - (st-blocks off-t) - (st-blksize unsigned-long) - (st-flags unsigned-long) - (st-gen unsigned-long) - (st-lspare long) - (st-qspare (array long 4)))) - -#+svr4 -(def-alien-type nil - (struct stat - (st-dev dev-t) - (st-pad1 #-linux (array long 3) #+linux unsigned-short) - (st-ino ino-t) - (st-mode #-linux unsigned-long #+linux unsigned-short) - (st-nlink #-linux short #+linux unsigned-short) - (st-uid #-linux uid-t #+linux unsigned-short) - (st-gid #-linux gid-t #+linux unsigned-short) - (st-rdev dev-t) - (st-pad2 #-linux (array long 2) #+linux unsigned-short) - (st-size off-t) - #-linux (st-pad3 long) - #+linux (st-blksize unsigned-long) - #+linux (st-blocks unsigned-long) - #-linux (st-atime (struct timestruc-t)) - #+linux (st-atime unsigned-long) - #+linux (unused-1 unsigned-long) - #-linux (st-mtime (struct timestruc-t)) - #+linux (st-mtime unsigned-long) - #+linux (unused-2 unsigned-long) - #-linux (st-ctime (struct timestruc-t)) - #+linux (st-ctime unsigned-long) - #+linux (unused-3 unsigned-long) - #+linux (unused-4 unsigned-long) - #+linux (unused-5 unsigned-long) - #-linux(st-blksize long) - #-linux (st-blocks long) - #-linux (st-fstype (array char 16)) - #-linux (st-pad4 (array long 8)))) - -#+linux -(def-alien-type nil - (struct stat - (st-dev dev-t) - #-(or alpha amd64) (st-pad1 unsigned-short) - (st-ino ino-t) - #+alpha (st-pad1 unsigned-int) - #-amd64 (st-mode mode-t) - (st-nlink nlink-t) - #+amd64 (st-mode mode-t) - (st-uid uid-t) - (st-gid gid-t) - (st-rdev dev-t) - #-alpha (st-pad2 unsigned-short) - (st-size off-t) - #-alpha (st-blksize unsigned-long) - #-alpha (st-blocks blkcnt-t) - (st-atime time-t) - #-alpha (unused-1 unsigned-long) - (st-mtime time-t) - #-alpha (unused-2 unsigned-long) - (st-ctime time-t) - #+alpha (st-blocks int) - #+alpha (st-pad2 unsigned-int) - #+alpha (st-blksize unsigned-int) - #+alpha (st-flags unsigned-int) - #+alpha (st-gen unsigned-int) - #+alpha (st-pad3 unsigned-int) - #+alpha (unused-1 unsigned-long) - #+alpha (unused-2 unsigned-long) - (unused-3 unsigned-long) - (unused-4 unsigned-long) - #-alpha (unused-5 unsigned-long))) - -;;; 64-bit stat for Solaris -#+solaris -(def-alien-type nil - (struct stat64 - (st-dev dev-t) - (st-pad1 (array long 3)) ; Pad so ino is 64-bit aligned - (st-ino ino64-t) - (st-mode unsigned-long) - (st-nlink short) - (st-uid uid-t) - (st-gid gid-t) - (st-rdev dev-t) - (st-pad2 (array long 3)) ; Pad so size is 64-bit aligned - (st-size off64-t) - (st-atime (struct timestruc-t)) - (st-mtime (struct timestruc-t)) - (st-ctime (struct timestruc-t)) - (st-blksize long) - (st-pad3 (array long 1)) ; Pad so blocks is 64-bit aligned - (st-blocks blkcnt64-t) - (st-fstype (array char 16)) - (st-pad4 (array long 8)))) - -#+netbsd -(def-alien-type nil - (struct stat - (st-dev dev-t) - (st-mode mode-t) - (st-ino ino-t) - (st-nlink nlink-t) - (st-uid uid-t) - (st-gid gid-t) - (st-rdev dev-t) - (st-atime (struct timespec-t)) - (st-mtime (struct timespec-t)) - (st-ctime (struct timespec-t)) - (st-birthtime (struct timespec-t)) - (st-size off-t) - (st-blocks off-t) - (st-blksize long) - (st-flags unsigned-long) - (st-gen unsigned-long) - (st-spare (array unsigned-long 2)))) - -#-linux -(defmacro extract-stat-results (buf) - `(values T - (slot ,buf 'st-dev) - (slot ,buf 'st-ino) - (slot ,buf 'st-mode) - (slot ,buf 'st-nlink) - (slot ,buf 'st-uid) - (slot ,buf 'st-gid) - (slot ,buf 'st-rdev) - (slot ,buf 'st-size) - #-(or svr4 BSD) (slot ,buf 'st-atime) - #+svr4 (slot (slot ,buf 'st-atime) 'tv-sec) - #+BSD (slot (slot ,buf 'st-atime) 'ts-sec) - #-(or svr4 BSD)(slot ,buf 'st-mtime) - #+svr4 (slot (slot ,buf 'st-mtime) 'tv-sec) - #+BSD(slot (slot ,buf 'st-mtime) 'ts-sec) - #-(or svr4 BSD) (slot ,buf 'st-ctime) - #+svr4 (slot (slot ,buf 'st-ctime) 'tv-sec) - #+BSD(slot (slot ,buf 'st-ctime) 'ts-sec) - #+netbsd (slot (slot ,buf 'st-birthtime) 'ts-sec) - (slot ,buf 'st-blksize) - (slot ,buf 'st-blocks))) - -#+linux -(defmacro extract-stat-results (buf) - `(values T - #+(or alpha amd64) - (slot ,buf 'st-dev) - #-(or alpha amd64) - (+ (deref (slot ,buf 'st-dev) 0) - (* (+ +max-u-long+ 1) - (deref (slot ,buf 'st-dev) 1))) ;;; let's hope this works.. - (slot ,buf 'st-ino) - (slot ,buf 'st-mode) - (slot ,buf 'st-nlink) - (slot ,buf 'st-uid) - (slot ,buf 'st-gid) - #+(or alpha amd64) - (slot ,buf 'st-rdev) - #-(or alpha amd64) - (+ (deref (slot ,buf 'st-rdev) 0) - (* (+ +max-u-long+ 1) - (deref (slot ,buf 'st-rdev) 1))) ;;; let's hope this works.. - (slot ,buf 'st-size) - (slot ,buf 'st-atime) - (slot ,buf 'st-mtime) - (slot ,buf 'st-ctime) - (slot ,buf 'st-blksize) - (slot ,buf 'st-blocks))) - -#-solaris -(progn -(defun unix-stat (name) - _N"Unix-stat retrieves information about the specified - file returning them in the form of multiple values. - See the UNIX Programmer's Manual for a description - of the values returned. If the call fails, then NIL - and an error number is returned instead." - (declare (type unix-pathname name)) - (when (string= name "") - (setf name ".")) - (with-alien ((buf (struct stat))) - (syscall (#+linux "stat64" #+netbsd "__stat50" #-(or linux netbsd) "stat" - c-string (* (struct stat))) - (extract-stat-results buf) - (%name->file name) (addr buf)))) - -(defun unix-lstat (name) - _N"Unix-lstat is similar to unix-stat except the specified - file must be a symbolic link." - (declare (type unix-pathname name)) - (with-alien ((buf (struct stat))) - (syscall (#+linux "lstat64" #+netbsd "__lstat50" #-(or linux netbsd) "lstat" - c-string (* (struct stat))) - (extract-stat-results buf) - (%name->file name) (addr buf)))) - -(defun unix-fstat (fd) - _N"Unix-fstat is similar to unix-stat except the file is specified - by the file descriptor fd." - (declare (type unix-fd fd)) - (with-alien ((buf (struct stat))) - (syscall (#+linux "fstat64" #+netbsd "__fstat50" #-(or linux netbsd) "fstat" - int (* (struct stat))) - (extract-stat-results buf) - fd (addr buf)))) -) - -;;; 64-bit versions of stat and friends -#+solaris -(progn -(defun unix-stat (name) - _N"Unix-stat retrieves information about the specified - file returning them in the form of multiple values. - See the UNIX Programmer's Manual for a description - of the values returned. If the call fails, then NIL - and an error number is returned instead." - (declare (type unix-pathname name)) - (when (string= name "") - (setf name ".")) - (with-alien ((buf (struct stat64))) - (syscall ("stat64" c-string (* (struct stat64))) - (extract-stat-results buf) - (%name->file name) (addr buf)))) - -(defun unix-lstat (name) - _N"Unix-lstat is similar to unix-stat except the specified - file must be a symbolic link." - (declare (type unix-pathname name)) - (with-alien ((buf (struct stat64))) - (syscall ("lstat64" c-string (* (struct stat64))) - (extract-stat-results buf) - (%name->file name) (addr buf)))) - -(defun unix-fstat (fd) - _N"Unix-fstat is similar to unix-stat except the file is specified - by the file descriptor fd." - (declare (type unix-fd fd)) - (with-alien ((buf (struct stat64))) - (syscall ("fstat64" int (* (struct stat64))) - (extract-stat-results buf) - fd (addr buf)))) -) +;; unix-stat and friends +(macrolet + ((call-stat (c-func-name first-arg-type first-arg) + ;; Call the stat function named C-FUNC-NAME. The type of the + ;; first arg is FIRST-ARG-TYPE and FIRST-ARG is the first arg + ;; to the stat function. fstat is different from stat and + ;; lstat since it takes an fd for the first arg instead of + ;; string. + `(with-alien ((dev c-call:long-long) + (ino c-call:unsigned-long-long) + (mode c-call:unsigned-int) + (nlink c-call:unsigned-long-long) + (uid c-call:unsigned-int) + (gid c-call:unsigned-int) + (rdev c-call:unsigned-long-long) + (size c-call:long-long) + (atime c-call:long-long) + (mtime c-call:long-long) + (ctime c-call:long-long) + (blksize c-call:long) + (blocks c-call:long-long)) + (let ((result + (alien-funcall + (extern-alien ,c-func-name + (function int + ,first-arg-type + (* c-call:long-long) + (* c-call:unsigned-long-long) + (* c-call:unsigned-int) + (* c-call:unsigned-long-long) + (* c-call:unsigned-int) + (* c-call:unsigned-int) + (* c-call:unsigned-long-long) + (* c-call:long-long) + (* c-call:long-long) + (* c-call:long-long) + (* c-call:long-long) + (* c-call:long) + (* c-call:long-long))) + ,first-arg + (addr dev) + (addr ino) + (addr mode) + (addr nlink) + (addr uid) + (addr gid) + (addr rdev) + (addr size) + (addr atime) + (addr mtime) + (addr ctime) + (addr blksize) + (addr blocks)))) + (if (eql -1 result) + (values nil (unix-errno)) + (values t + dev + ino + mode + nlink + uid + gid + rdev + size + atime + mtime + ctime + blksize + blocks)))))) + (defun unix-stat (name) + _N"Unix-stat retrieves information about the specified + file returning them in the form of multiple values. If the call + fails, then NIL and an error number is returned. If the call + succeeds, then T is returned in addition to the following values + from the stat struct st: + + st_dev Device ID + st_ino File serial number + st_mode Mode of file + st_nlink Number of hard links to the file + st_uid User ID + st_gid Group ID + st_rdev Device ID (if file is character or block special) + st_atime Last data access time, in sec + st_mtime Last data modification time, in sec + st_ctime Last file status change time, in sec + st_blksize Preferred I/O block size + st_blocks Number of blocks allocated. (Block size is implementation dependent.) +" + (declare (type unix-pathname name)) + (when (string= name "") + (setf name ".")) + (call-stat "os_stat" c-call:c-string (%name->file name))) + + (defun unix-lstat (name) + "Unix-lstat is similar to unix-stat except the specified + file must be a symbolic link. If the call fails, then NIL and an + error number is returned. If the call succeeds, then T is returned + in addition to the following values from the stat struct st: + + st_dev Device ID + st_ino File serial number + st_mode Mode of file + st_nlink Number of hard links to the file + st_uid User ID + st_gid Group ID + st_rdev Device ID (if file is character or block special) + st_atime Last data access time, in sec + st_mtime Last data modification time, in sec + st_ctime Last file status change time, in sec + st_blksize Preferred I/O block size + st_blocks Number of blocks allocated. (Block size is implementation dependent.) +" + (declare (type unix-pathname name)) + (call-stat "os_lstat" c-call:c-string (%name->file name))) + + (defun unix-fstat (fd) + _N"Unix-fstat is similar to unix-stat except the file is specified + by the file descriptor fd. If the call fails, then NIL and an + error number is returned. If the call succeeds, then T is returned + in addition to the following values from the stat struct st: + + st_dev Device ID + st_ino File serial number + st_mode Mode of file + st_nlink Number of hard links to the file + st_uid User ID + st_gid Group ID + st_rdev Device ID (if file is character or block special) + st_atime Last data access time, in sec + st_mtime Last data modification time, in sec + st_ctime Last file status change time, in sec + st_blksize Preferred I/O block size + st_blocks Number of blocks allocated. (Block size is implementation dependent.) +" + (declare (type unix-fd fd)) + (call-stat "os_fstat" int fd))) (def-alien-type nil (struct rusage ===================================== src/contrib/unix/unix-glibc2.lisp ===================================== @@ -175,7 +175,7 @@ TIOCSIGSEND KBDCGET KBDCSET KBDCRESET KBDCRST KBDCSSTD KBDSGET KBDGCLICK - KBDSCLICK FIONREAD unix-exit unix-stat unix-lstat unix-fstat + KBDSCLICK FIONREAD unix-exit unix-getrusage unix-fast-getrusage rusage_self rusage_children unix-gettimeofday unix-utimes unix-sched-yield unix-setreuid ===================================== src/contrib/unix/unix.lisp ===================================== @@ -159,7 +159,7 @@ KBDCGET KBDCSET KBDCRESET KBDCRST KBDCSSTD KBDSGET KBDGCLICK KBDSCLICK FIONREAD #+(or hpux bsd) siocspgrp - unix-exit unix-stat unix-lstat unix-fstat + unix-exit unix-getrusage unix-fast-getrusage rusage_self rusage_children unix-gettimeofday #-hpux unix-utimes #-(or svr4 hpux) unix-setreuid @@ -230,50 +230,6 @@ ;;; -;;; From sys/stat.h -;; oh boy, in linux-> 2 stat(s)!! - -#-(or svr4 bsd linux) ; eg hpux and alpha -(def-alien-type nil - (struct stat - (st-dev dev-t) - (st-ino ino-t) - (st-mode mode-t) - (st-nlink nlink-t) - (st-uid uid-t) - (st-gid gid-t) - (st-rdev dev-t) - (st-size off-t) - (st-atime time-t) - (st-spare1 int) - (st-mtime time-t) - (st-spare2 int) - (st-ctime time-t) - (st-spare3 int) - (st-blksize #-alpha long #+alpha unsigned-int) - (st-blocks #-alpha long #+alpha int) - (st-spare4 (array long 2)))) - -#+netbsd -(def-alien-type nil - (struct stat - (st-dev dev-t) - (st-mode mode-t) - (st-ino ino-t) - (st-nlink nlink-t) - (st-uid uid-t) - (st-gid gid-t) - (st-rdev dev-t) - (st-atime (struct timespec-t)) - (st-mtime (struct timespec-t)) - (st-ctime (struct timespec-t)) - (st-birthtime (struct timespec-t)) - (st-size off-t) - (st-blocks off-t) - (st-blksize long) - (st-flags unsigned-long) - (st-gen unsigned-long) - (st-spare (array unsigned-long 2)))) ;;; From sys/resource.h ===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -489,22 +489,71 @@ msgstr "" #: src/code/unix.lisp msgid "" "Unix-stat retrieves information about the specified\n" -" file returning them in the form of multiple values.\n" -" See the UNIX Programmer's Manual for a description\n" -" of the values returned. If the call fails, then NIL\n" -" and an error number is returned instead." +" file returning them in the form of multiple values. If the call\n" +" fails, then NIL and an error number is returned. If the call\n" +" succeeds, then T is returned in addition to the following values\n" +" from the stat struct st:\n" +"\n" +" st_dev Device ID\n" +" st_ino File serial number\n" +" st_mode Mode of file\n" +" st_nlink Number of hard links to the file\n" +" st_uid User ID\n" +" st_gid Group ID\n" +" st_rdev Device ID (if file is character or block special)\n" +" st_atime Last data access time, in sec\n" +" st_mtime Last data modification time, in sec\n" +" st_ctime Last file status change time, in sec\n" +" st_blksize Preferred I/O block size\n" +" st_blocks Number of blocks allocated. (Block size is implementation" +" dependent.)\n" +"" msgstr "" #: src/code/unix.lisp msgid "" -"Unix-lstat is similar to unix-stat except the specified\n" -" file must be a symbolic link." +"Unix-fstat is similar to unix-stat except the file is specified\n" +" by the file descriptor fd. If the call fails, then NIL and an\n" +" error number is returned. If the call succeeds, then T is returned\n" +" in addition to the following values from the stat struct st:\n" +"\n" +" st_dev Device ID\n" +" st_ino File serial number\n" +" st_mode Mode of file\n" +" st_nlink Number of hard links to the file\n" +" st_uid User ID\n" +" st_gid Group ID\n" +" st_rdev Device ID (if file is character or block special)\n" +" st_atime Last data access time, in sec\n" +" st_mtime Last data modification time, in sec\n" +" st_ctime Last file status change time, in sec\n" +" st_blksize Preferred I/O block size\n" +" st_blocks Number of blocks allocated. (Block size is implementation" +" dependent.)\n" +"" msgstr "" #: src/code/unix.lisp msgid "" -"Unix-fstat is similar to unix-stat except the file is specified\n" -" by the file descriptor fd." +"Unix-lstat is similar to unix-stat except the specified\n" +" file must be a symbolic link. If the call fails, then NIL and an\n" +" error number is returned. If the call succeeds, then T is returned\n" +" in addition to the following values from the stat struct st:\n" +"\n" +" st_dev Device ID\n" +" st_ino File serial number\n" +" st_mode Mode of file\n" +" st_nlink Number of hard links to the file\n" +" st_uid User ID\n" +" st_gid Group ID\n" +" st_rdev Device ID (if file is character or block special)\n" +" st_atime Last data access time, in sec\n" +" st_mtime Last data modification time, in sec\n" +" st_ctime Last file status change time, in sec\n" +" st_blksize Preferred I/O block size\n" +" st_blocks Number of blocks allocated. (Block size is implementation" +" dependent.)\n" +"" msgstr "" #: src/code/unix.lisp ===================================== src/lisp/Config.x86_linux ===================================== @@ -4,6 +4,7 @@ include Config.x86_common CFLAGS += $(COPT) CPPFLAGS += -m32 -D__NO_CTYPE CFLAGS += -rdynamic -march=pentium4 -mfpmath=sse -mtune=generic +CFLAGS += -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 UNDEFSYMPATTERN = -Xlinker -u -Xlinker & ASSEM_SRC += linux-stubs.S ===================================== src/lisp/Config.x86_linux_clang ===================================== @@ -9,6 +9,7 @@ CFLAGS += $(COPT) # (-mtune=pentium4), the first chip to have sse2; and finally generate # code assuming instructions can trap (-ftrapping-math). CFLAGS += -msse2 -mtune=pentium4 -ftrapping-math +CFLAGS += -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 UNDEFSYMPATTERN = -Xlinker -u -Xlinker & ASSEM_SRC += linux-stubs.S ===================================== src/lisp/os-common.c ===================================== @@ -10,6 +10,7 @@ #include <netdb.h> #include <stdio.h> #include <string.h> +#include <sys/stat.h> #include <time.h> #include "os.h" @@ -589,3 +590,128 @@ os_sleep(double seconds) requested = remaining; } } + +/* + * Interface to stat/fstat/lstat. + * + * The arg types are chosen such that they can hold the largest + * possible value that any OS would use for the particular slot in the + * stat structure. That way we can just use one OS-independent + * function that works across all OSes. + */ +int +os_stat(const char* path, u_int64_t *dev, u_int64_t *ino, unsigned int *mode, u_int64_t *nlink, + unsigned int *uid, unsigned int *gid, u_int64_t *rdev, int64_t *size, + int64_t *atime, int64_t *mtime, int64_t *ctime, + long *blksize, int64_t *blocks) +{ + int rc; + struct stat buf; + + rc = stat(path, &buf); + + if (rc != 0) { + return rc; + } + +#if 0 + /* + * Useful prints to see the actual size of the various + * fields. Helpful for porting this to other OSes that we haven't + * tested on. + */ + fprintf(stderr, "size dev %d\n", sizeof(buf.st_dev)); + fprintf(stderr, "size ino %d\n", sizeof(buf.st_ino)); + fprintf(stderr, "size mode %d\n", sizeof(buf.st_mode)); + fprintf(stderr, "size nlink %d\n", sizeof(buf.st_nlink)); + fprintf(stderr, "size uid %d\n", sizeof(buf.st_uid)); + fprintf(stderr, "size gid %d\n", sizeof(buf.st_gid)); + fprintf(stderr, "size rdev %d\n", sizeof(buf.st_rdev)); + fprintf(stderr, "size size %d\n", sizeof(buf.st_size)); + fprintf(stderr, "size atime %d\n", sizeof(buf.st_atime)); + fprintf(stderr, "size mtime %d\n", sizeof(buf.st_mtime)); + fprintf(stderr, "size ctime %d\n", sizeof(buf.st_ctime)); + fprintf(stderr, "size blksize %d\n", sizeof(buf.st_blksize)); + fprintf(stderr, "size blocks %d\n", sizeof(buf.st_blocks)); +#endif + + *dev = buf.st_dev; + *ino = buf.st_ino; + *mode = buf.st_mode; + *nlink = buf.st_nlink; + *uid = buf.st_uid; + *gid = buf.st_gid; + *rdev = buf.st_rdev; + *size = buf.st_size; + *atime = buf.st_atime; + *mtime = buf.st_mtime; + *ctime = buf.st_ctime; + *blksize = buf.st_blksize; + *blocks = buf.st_blocks; + + return rc; +} + +int +os_fstat(int fd, u_int64_t *dev, u_int64_t *ino, unsigned int *mode, u_int64_t *nlink, + unsigned int *uid, unsigned int *gid, u_int64_t *rdev, int64_t *size, + int64_t *atime, int64_t *mtime, int64_t *ctime, + long *blksize, int64_t *blocks) +{ + int rc; + struct stat buf; + + rc = fstat(fd, &buf); + + if (rc != 0) { + return rc; + } + + *dev = buf.st_dev; + *ino = buf.st_ino; + *mode = buf.st_mode; + *nlink = buf.st_nlink; + *uid = buf.st_uid; + *gid = buf.st_gid; + *rdev = buf.st_rdev; + *size = buf.st_size; + *atime = buf.st_atime; + *mtime = buf.st_mtime; + *ctime = buf.st_ctime; + *blksize = buf.st_blksize; + *blocks = buf.st_blocks; + + return rc; +} + +int +os_lstat(const char* path, u_int64_t *dev, u_int64_t *ino, unsigned int *mode, u_int64_t *nlink, + unsigned int *uid, unsigned int *gid, u_int64_t *rdev, int64_t *size, + int64_t *atime, int64_t *mtime, int64_t *ctime, + long *blksize, int64_t *blocks) +{ + int rc; + struct stat buf; + + rc = lstat(path, &buf); + + if (rc != 0) { + return rc; + } + + *dev = buf.st_dev; + *ino = buf.st_ino; + *mode = buf.st_mode; + *nlink = buf.st_nlink; + *uid = buf.st_uid; + *gid = buf.st_gid; + *rdev = buf.st_rdev; + *size = buf.st_size; + *atime = buf.st_atime; + *mtime = buf.st_mtime; + *ctime = buf.st_ctime; + *blksize = buf.st_blksize; + *blocks = buf.st_blocks; + + return rc; +} View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/f62f1e9ee9835281ee42b6… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/f62f1e9ee9835281ee42b6… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-125-unix-stat-wrong] Disable debugging prints
by Raymond Toy (＠rtoy) 23 Aug '22

23 Aug '22

Raymond Toy pushed to branch issue-125-unix-stat-wrong at cmucl / cmucl Commits: 834ff140 by Raymond Toy at 2022-08-23T15:29:31-07:00 Disable debugging prints - - - - - 1 changed file: - src/lisp/os-common.c Changes: ===================================== src/lisp/os-common.c ===================================== @@ -614,7 +614,7 @@ os_stat(const char* path, u_int64_t *dev, u_int64_t *ino, unsigned int *mode, u_ return rc; } -#if 1 +#if 0 /* * Useful prints to see the actual size of the various * fields. Helpful for porting this to other OSes that we haven't View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/834ff140fb6080c2a7008d4… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/834ff140fb6080c2a7008d4… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-125-unix-stat-wrong] Keep include files sorted
by Raymond Toy (＠rtoy) 23 Aug '22

23 Aug '22

Raymond Toy pushed to branch issue-125-unix-stat-wrong at cmucl / cmucl Commits: bf5b52fa by Carl S. Shapiro at 2022-08-23T22:28:11+00:00 Keep include files sorted - - - - - 1 changed file: - src/lisp/os-common.c Changes: ===================================== src/lisp/os-common.c ===================================== @@ -10,8 +10,8 @@ #include <netdb.h> #include <stdio.h> #include <string.h> -#include <time.h> #include <sys/stat.h> +#include <time.h> #include "os.h" #include "internals.h" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/bf5b52faf340040fa9a53a8… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/bf5b52faf340040fa9a53a8… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-125-unix-stat-wrong] Update pot file
by Raymond Toy (＠rtoy) 20 Aug '22

20 Aug '22

Raymond Toy pushed to branch issue-125-unix-stat-wrong at cmucl / cmucl Commits: 164bd106 by Raymond Toy at 2022-08-20T15:18:05-07:00 Update pot file The docstrings for unix-stat and friends have changed, so the pot file needs updating. - - - - - 1 changed file: - src/i18n/locale/cmucl-unix.pot Changes: ===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -556,27 +556,6 @@ msgid "" "" msgstr "" -#: src/code/unix.lisp -msgid "" -"Unix-stat retrieves information about the specified\n" -" file returning them in the form of multiple values.\n" -" See the UNIX Programmer's Manual for a description\n" -" of the values returned. If the call fails, then NIL\n" -" and an error number is returned instead." -msgstr "" - -#: src/code/unix.lisp -msgid "" -"Unix-lstat is similar to unix-stat except the specified\n" -" file must be a symbolic link." -msgstr "" - -#: src/code/unix.lisp -msgid "" -"Unix-fstat is similar to unix-stat except the file is specified\n" -" by the file descriptor fd." -msgstr "" - #: src/code/unix.lisp msgid "The calling process." msgstr "" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/164bd106c8aed710af34a30… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/164bd106c8aed710af34a30… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-125-unix-stat-wrong] Set _LARGEFILE_SOURCE and _FILE_OFFSET_BITS here
by Raymond Toy (＠rtoy) 14 Aug '22

14 Aug '22

Raymond Toy pushed to branch issue-125-unix-stat-wrong at cmucl / cmucl Commits: fdec8705 by Raymond Toy at 2022-08-14T08:34:55-07:00 Set _LARGEFILE_SOURCE and _FILE_OFFSET_BITS here Enable large file support by setting the c flags. Needed by os-common.c to support large files for os_stat and friends. - - - - - 2 changed files: - src/lisp/Config.x86_linux - src/lisp/Config.x86_linux_clang Changes: ===================================== src/lisp/Config.x86_linux ===================================== @@ -4,6 +4,7 @@ include Config.x86_common CFLAGS += $(COPT) CPPFLAGS += -m32 -D__NO_CTYPE CFLAGS += -rdynamic -march=pentium4 -mfpmath=sse -mtune=generic +CFLAGS += -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 UNDEFSYMPATTERN = -Xlinker -u -Xlinker & ASSEM_SRC += linux-stubs.S ===================================== src/lisp/Config.x86_linux_clang ===================================== @@ -9,6 +9,7 @@ CFLAGS += $(COPT) # (-mtune=pentium4), the first chip to have sse2; and finally generate # code assuming instructions can trap (-ftrapping-math). CFLAGS += -msse2 -mtune=pentium4 -ftrapping-math +CFLAGS += -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 UNDEFSYMPATTERN = -Xlinker -u -Xlinker & ASSEM_SRC += linux-stubs.S View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/fdec87055478c8f2d10a6c3… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/fdec87055478c8f2d10a6c3… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Fix some typos.
by Raymond Toy (＠rtoy) 14 Aug '22

14 Aug '22

Raymond Toy pushed to branch master at cmucl / cmucl Commits: f62f1e9e by Raymond Toy at 2022-08-14T08:09:53-07:00 Fix some typos. One was mentioned in !87. Found a few more typos so fixed those too. - - - - - 1 changed file: - src/general-info/release-21e.md Changes: ===================================== src/general-info/release-21e.md ===================================== @@ -1,10 +1,10 @@ # CMUCL 21e -## Work in prograss +## Work in progress The CMUCL project is pleased to announce the release of CMUCL 21e. This is a major release which contains numerous enhancements and bug -fixes from the 21a release. +fixes from the 21d release. CMUCL is a free, high performance implementation of the Common Lisp programming language which runs on most major Unix platforms. It @@ -39,15 +39,15 @@ public domain. * ~~#90~~ Some static symbols have been removed. This probably makes the fasl files incompatible with older versions. * ~~#91~~ Loop destructuring no longer incorrectly signals an error * ~~#95~~ Disassembler syntax of x86 je and movzx is incorrect - * ~~#97~~ Define and use ud2 instruction isntead of int3. Fixes single-stepping. + * ~~#97~~ Define and use ud2 instruction instead of int3. Fixes single-stepping. * ~~#98~~ fstpd is not an Intel instruction; disassemble as `fstp dword ptr [addr]` - * ~~#100~~ ldb prints out unicode base-chars correctly instead of just the low 8 bits. + * ~~#100~~ ldb prints out Unicode base-chars correctly instead of just the low 8 bits. * ~~#103~~ RANDOM-MT19937-UPDATE assembly routine still exists * ~~#104~~ Single-stepping broken (fixed via #97). * ~~#107~~ Replace u_int8_t with uint8_t * ~~#108~~ Update ASDF * ~~#112~~ CLX can't connect to X server via inet sockets - * ~~#113~~ REQUIRE on contribs can pull in the wrong things vai ASDF. + * ~~#113~~ REQUIRE on contribs can pull in the wrong things via ASDF. * ~~#121~~ Wrong column index in FILL-POINTER-OUTPUT-STREAM * ~~#122~~ gcc 11 can't build cmucl * ~~#127~~ Linux unix-getpwuid segfaults when given non-existent uid. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/f62f1e9ee9835281ee42b6f… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/f62f1e9ee9835281ee42b6f… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #128: quit accepts an exit code
by Raymond Toy (＠rtoy) 14 Aug '22

14 Aug '22

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 9cf3916e by Raymond Toy at 2022-08-14T15:00:30+00:00 Fix #128: quit accepts an exit code - - - - - 3aec3f5e by Raymond Toy at 2022-08-14T15:00:31+00:00 Merge branch 'issue-128-quit-exit-code' into 'master' Fix #128: quit accepts an exit code Closes #128 See merge request cmucl/cmucl!87 - - - - - 3 changed files: - src/code/lispinit.lisp - src/general-info/release-21e.md - src/i18n/locale/cmucl.pot Changes: ===================================== src/code/lispinit.lisp ===================================== @@ -492,14 +492,15 @@ ;;; Quit gets us out, one way or another. -(defun quit (&optional recklessly-p) - "Terminates the current Lisp. Things are cleaned up unless Recklessly-P is - non-Nil." +(defun quit (&optional recklessly-p (code 0)) + "Terminates the current Lisp. Things are cleaned up unless + Recklessly-P is non-Nil. On quitting, Lisp sets the return code to + Code, defaulting to 0." (if recklessly-p - (unix:unix-exit 0) + (unix:unix-exit code) (progn (mapc (lambda (fn) (ignore-errors (funcall fn))) *cleanup-functions*) - (throw '%end-of-the-world 0)))) + (throw '%end-of-the-world code)))) #-mp ; Multi-processing version defined in multi-proc.lisp. ===================================== src/general-info/release-21e.md ===================================== @@ -51,6 +51,7 @@ public domain. * ~~#121~~ Wrong column index in FILL-POINTER-OUTPUT-STREAM * ~~#122~~ gcc 11 can't build cmucl * ~~#127~~ Linux unix-getpwuid segfaults when given non-existent uid. + * ~~#128~~ `QUIT` accepts an exit code * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -309,8 +309,9 @@ msgstr "" #: src/code/lispinit.lisp msgid "" -"Terminates the current Lisp. Things are cleaned up unless Recklessly-P is\n" -" non-Nil." +"Terminates the current Lisp. Things are cleaned up unless\n" +" Recklessly-P is non-Nil. On quitting, Lisp sets the return code to\n" +" Code, defaulting to 0." msgstr "" #: src/code/lispinit.lisp View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/88ca0184f219100c92888c… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/88ca0184f219100c92888c… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-125-unix-stat-wrong] Address review comments
by Raymond Toy (＠rtoy) 14 Aug '22

14 Aug '22

Raymond Toy pushed to branch issue-125-unix-stat-wrong at cmucl / cmucl Commits: 6f0f8c05 by Raymond Toy at 2022-08-13T17:51:12-07:00 Address review comments In unix.lisp, use `c-call:long-long` and `c-call:unsigned-long-long` instead of `int64-t` and `u-int64-t`. Renamed functions from `unix_stat` to `os_stat`. In `os_stat` and friends, if the syscall fails, just return with the code instead of copying random stuff. - - - - - 2 changed files: - src/code/unix.lisp - src/lisp/os-common.c Changes: ===================================== src/code/unix.lisp ===================================== @@ -1337,37 +1337,37 @@ ;; to the stat function. fstat is different from stat and ;; lstat since it takes an fd for the first arg instead of ;; string. - `(with-alien ((dev u-int64-t) - (ino u-int64-t) + `(with-alien ((dev c-call:long-long) + (ino c-call:unsigned-long-long) (mode c-call:unsigned-int) - (nlink u-int64-t) + (nlink c-call:unsigned-long-long) (uid c-call:unsigned-int) (gid c-call:unsigned-int) - (rdev u-int64-t) - (size int64-t) - (atime int64-t) - (mtime int64-t) - (ctime int64-t) + (rdev c-call:unsigned-long-long) + (size c-call:long-long) + (atime c-call:long-long) + (mtime c-call:long-long) + (ctime c-call:long-long) (blksize c-call:long) - (blocks int64-t)) + (blocks c-call:long-long)) (let ((result (alien-funcall (extern-alien ,c-func-name (function int ,first-arg-type - (* u-int64-t) - (* u-int64-t) + (* c-call:long-long) + (* c-call:unsigned-long-long) (* c-call:unsigned-int) - (* u-int64-t) + (* c-call:unsigned-long-long) (* c-call:unsigned-int) (* c-call:unsigned-int) - (* u-int64-t) - (* int64-t) - (* int64-t) - (* int64-t) - (* int64-t) + (* c-call:unsigned-long-long) + (* c-call:long-long) + (* c-call:long-long) + (* c-call:long-long) + (* c-call:long-long) (* c-call:long) - (* int64-t))) + (* c-call:long-long))) ,first-arg (addr dev) (addr ino) @@ -1421,7 +1421,7 @@ (declare (type unix-pathname name)) (when (string= name "") (setf name ".")) - (call-stat "unix_stat" c-call:c-string (%name->file name))) + (call-stat "os_stat" c-call:c-string (%name->file name))) (defun unix-lstat (name) "Unix-lstat is similar to unix-stat except the specified @@ -1443,7 +1443,7 @@ st_blocks Number of blocks allocated. (Block size is implementation dependent.) " (declare (type unix-pathname name)) - (call-stat "unix_lstat" c-call:c-string (%name->file name))) + (call-stat "os_lstat" c-call:c-string (%name->file name))) (defun unix-fstat (fd) _N"Unix-fstat is similar to unix-stat except the file is specified @@ -1465,7 +1465,7 @@ st_blocks Number of blocks allocated. (Block size is implementation dependent.) " (declare (type unix-fd fd)) - (call-stat "unix_fstat" int fd))) + (call-stat "os_fstat" int fd))) (def-alien-type nil (struct rusage ===================================== src/lisp/os-common.c ===================================== @@ -5,12 +5,6 @@ */ -#ifdef __linux__ -/* Needed to get 64-bit objects for stat and friends on Linux. */ -#define _LARGEFILE_SOURCE -#define _FILE_OFFSET_BITS 64 -#endif - #include <errno.h> #include <math.h> #include <netdb.h> @@ -606,17 +600,21 @@ os_sleep(double seconds) * function that works across all OSes. */ int -unix_stat(const char* path, u_int64_t *dev, u_int64_t *ino, unsigned int *mode, u_int64_t *nlink, - unsigned int *uid, unsigned int *gid, u_int64_t *rdev, int64_t *size, - int64_t *atime, int64_t *mtime, int64_t *ctime, - long *blksize, int64_t *blocks) +os_stat(const char* path, u_int64_t *dev, u_int64_t *ino, unsigned int *mode, u_int64_t *nlink, + unsigned int *uid, unsigned int *gid, u_int64_t *rdev, int64_t *size, + int64_t *atime, int64_t *mtime, int64_t *ctime, + long *blksize, int64_t *blocks) { int rc; struct stat buf; rc = stat(path, &buf); -#if 0 + if (rc != 0) { + return rc; + } + +#if 1 /* * Useful prints to see the actual size of the various * fields. Helpful for porting this to other OSes that we haven't @@ -655,16 +653,20 @@ unix_stat(const char* path, u_int64_t *dev, u_int64_t *ino, unsigned int *mode, } int -unix_fstat(int fd, u_int64_t *dev, u_int64_t *ino, unsigned int *mode, u_int64_t *nlink, - unsigned int *uid, unsigned int *gid, u_int64_t *rdev, int64_t *size, - int64_t *atime, int64_t *mtime, int64_t *ctime, - long *blksize, int64_t *blocks) +os_fstat(int fd, u_int64_t *dev, u_int64_t *ino, unsigned int *mode, u_int64_t *nlink, + unsigned int *uid, unsigned int *gid, u_int64_t *rdev, int64_t *size, + int64_t *atime, int64_t *mtime, int64_t *ctime, + long *blksize, int64_t *blocks) { int rc; struct stat buf; rc = fstat(fd, &buf); + if (rc != 0) { + return rc; + } + *dev = buf.st_dev; *ino = buf.st_ino; *mode = buf.st_mode; @@ -683,16 +685,20 @@ unix_fstat(int fd, u_int64_t *dev, u_int64_t *ino, unsigned int *mode, u_int64_t } int -unix_lstat(const char* path, u_int64_t *dev, u_int64_t *ino, unsigned int *mode, u_int64_t *nlink, - unsigned int *uid, unsigned int *gid, u_int64_t *rdev, int64_t *size, - int64_t *atime, int64_t *mtime, int64_t *ctime, - long *blksize, int64_t *blocks) +os_lstat(const char* path, u_int64_t *dev, u_int64_t *ino, unsigned int *mode, u_int64_t *nlink, + unsigned int *uid, unsigned int *gid, u_int64_t *rdev, int64_t *size, + int64_t *atime, int64_t *mtime, int64_t *ctime, + long *blksize, int64_t *blocks) { int rc; struct stat buf; rc = lstat(path, &buf); + if (rc != 0) { + return rc; + } + *dev = buf.st_dev; *ino = buf.st_ino; *mode = buf.st_mode; View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6f0f8c0501d22d6e63d237f… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6f0f8c0501d22d6e63d237f… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-128-quit-exit-code] Rename exit-code to code.
by Raymond Toy (＠rtoy) 14 Aug '22

14 Aug '22

Raymond Toy pushed to branch issue-128-quit-exit-code at cmucl / cmucl Commits: bfdd1d8c by Raymond Toy at 2022-08-13T17:20:01-07:00 Rename exit-code to code. Carl, offline, suggested renaming exit-code to just code. The docstring is also updated, along with the pot file because the docstring changed. Update the release notes as well. - - - - - 3 changed files: - src/code/lispinit.lisp - src/general-info/release-21e.md - src/i18n/locale/cmucl.pot Changes: ===================================== src/code/lispinit.lisp ===================================== @@ -492,15 +492,15 @@ ;;; Quit gets us out, one way or another. -(defun quit (&optional recklessly-p (exit-code 0)) +(defun quit (&optional recklessly-p (code 0)) "Terminates the current Lisp. Things are cleaned up unless Recklessly-P is non-Nil. On quitting, Lisp sets the return code to - exit-code, defaulting to 0." + Code, defaulting to 0." (if recklessly-p - (unix:unix-exit exit-code) + (unix:unix-exit code) (progn (mapc (lambda (fn) (ignore-errors (funcall fn))) *cleanup-functions*) - (throw '%end-of-the-world exit-code)))) + (throw '%end-of-the-world code)))) #-mp ; Multi-processing version defined in multi-proc.lisp. ===================================== src/general-info/release-21e.md ===================================== @@ -51,6 +51,7 @@ public domain. * ~~#121~~ Wrong column index in FILL-POINTER-OUTPUT-STREAM * ~~#122~~ gcc 11 can't build cmucl * ~~#127~~ Linux unix-getpwuid segfaults when given non-existent uid. + * ~~#128~~ `QUIT` accepts an exit code * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -311,7 +311,7 @@ msgstr "" msgid "" "Terminates the current Lisp. Things are cleaned up unless\n" " Recklessly-P is non-Nil. On quitting, Lisp sets the return code to\n" -" exit-code, defaulting to 0." +" Code, defaulting to 0." msgstr "" #: src/code/lispinit.lisp View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/bfdd1d8c039f13caf593472… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/bfdd1d8c039f13caf593472… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-128-quit-exit-code
by Raymond Toy (＠rtoy) 12 Aug '22

12 Aug '22

Raymond Toy pushed new branch issue-128-quit-exit-code at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-128-quit-exit-code You're receiving this email because of your account on gitlab.common-lisp.net.

1 0