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