Raymond Toy pushed to branch issue-337-cross-compile-linux-x86-fails at cmucl / cmucl

Commits: 4bb23b29 by Raymond Toy at 2024-07-18T06:29:53-07:00 Import lisp::+ascii-limit+ to the C package

Revert the previous changes, leaving `+ascii-limit+` in the `lisp` package. But then import it into the `C` package.

For this to work, the compiler using for cross-compiling has to have this change already.

- - - - - 8ada0f1e by Raymond Toy at 2024-07-18T06:35:36-07:00 Update CI to use the linux:build as the cross-compiling lisp.

- - - - -

6 changed files:

- .gitlab-ci.yml - src/code/char.lisp - src/code/exports.lisp - src/code/unicode.lisp - src/compiler/srctran.lisp - src/i18n/locale/cmucl.pot

Changes:

===================================== .gitlab-ci.yml ===================================== @@ -63,7 +63,13 @@ linux:cross-build: - linux-3/*.log - linux-4/*.log needs: - - job: linux:install + + # Normally need the linux:install stage to get the compiler to + # use. But for #337, we need the normal build from linux:build to + # do the cross-compile. Once the snapshot is made, we can use + # linux:install instead. + - job: linux:build + #- job: linux:install artifacts: true script: - bin/create-target.sh xtarget

===================================== src/code/char.lisp ===================================== @@ -59,6 +59,11 @@ (deftype codepoint () `(integer 0 (,codepoint-limit)))

+(defconstant +ascii-limit+ + 127 + "A character code strictly larger than this is handled using Unicode + rules.") + ;; Table of mappings for upper case and lower case letters. See ;; src/lisp/case-mapping.c. (alien:def-alien-variable "case_mapping" @@ -255,7 +260,7 @@ (let ((m (char-code (the base-char char)))) (or (<= (char-code #\space ) m (char-code #~)) #+(and unicode (not unicode-bootstrap)) - (and (> m c::+ascii-limit+) + (and (> m +ascii-limit+) (>= (unicode-category m) +unicode-category-graphic+))))))

@@ -267,7 +272,7 @@ (or (<= (char-code #\A) m (char-code #\Z)) (<= (char-code #\a) m (char-code #\z)) #+(and unicode (not unicode-bootstrap)) - (and (> m c::+ascii-limit+) + (and (> m +ascii-limit+) (<= +unicode-category-letter+ (unicode-category m) (+ +unicode-category-letter+ #x0F))))))

@@ -279,7 +284,7 @@ (let ((m (char-code char))) (or (<= (char-code #\A) m (char-code #\Z)) #+(and unicode (not unicode-bootstrap)) - (and (> m c::+ascii-limit+) + (and (> m +ascii-limit+) (not (zerop (ldb +lower-case-entry+ (case-mapping-entry m))))))))

@@ -290,7 +295,7 @@ (let ((m (char-code char))) (or (<= (char-code #\a) m (char-code #\z)) #+(and unicode (not unicode-bootstrap)) - (and (> m c::+ascii-limit+) + (and (> m +ascii-limit+) (not (zerop (ldb +upper-case-entry+ (case-mapping-entry m))))))))

(defun both-case-p (char) @@ -302,7 +307,7 @@ (or (<= (char-code #\A) m (char-code #\Z)) (<= (char-code #\a) m (char-code #\z)) #+(and unicode (not unicode-bootstrap)) - (and (> m c::+ascii-limit+) + (and (> m +ascii-limit+) (not (zerop (case-mapping-entry m)))))))

@@ -336,7 +341,7 @@ (<= (char-code #\A) m (char-code #\Z)) (<= (char-code #\a) m (char-code #\z)) #+(and unicode (not unicode-bootstrap)) - (and (> m c::+ascii-limit+) + (and (> m +ascii-limit+) (<= +unicode-category-letter+ (unicode-category m) (+ +unicode-category-letter+ #x0F))))))

@@ -409,7 +414,7 @@ (cond ((<= (char-code #\A) ch (char-code #\Z)) (logxor ch #x20)) #+(and unicode (not unicode-bootstrap)) - ((> ch c::+ascii-limit+) + ((> ch +ascii-limit+) (case-mapping-lower-case ch)) (t ch))))

===================================== src/code/exports.lisp ===================================== @@ -1067,7 +1067,8 @@ "CHAR-TITLECASE" "TITLE-CASE-P" "GLYPH" "SGLYPH" "STRING-TO-NFC" - "CODEPOINT-LIMIT" "CODEPOINT") + "CODEPOINT-LIMIT" "CODEPOINT" + "+ASCII-LIMIT+") ;; Unicode (:export "STRING-TO-NFC" "STRING-TO-NFD" "STRING-TO-NFKC" "STRING-TO-NFKD" @@ -1858,7 +1859,8 @@ "%SP-STRING-COMPARE" "%SVSET" "%TYPEP" "SHORT-FLOAT-P" "STRING/=*" "STRING<*" "STRING<=*" "STRING=*" - "STRING>*" "STRING>=*") + "STRING>*" "STRING>=*" + "+ASCII-LIMIT+") (:import-from "SYSTEM" "FOREIGN-SYMBOL-ADDRESS" "FOREIGN-SYMBOL-CODE-ADDRESS" "FOREIGN-SYMBOL-DATA-ADDRESS") (:import-from "EXTENSIONS"

===================================== src/code/unicode.lisp ===================================== @@ -495,7 +495,7 @@ (cond ((<= (char-code #\a) m (char-code #\z)) (code-char (logxor m #x20))) #+(and unicode (not unicode-bootstrap)) - ((> m c::+ascii-limit+) + ((> m lisp::+ascii-limit+) (code-char (lisp::unicode-title m))) (t char))))

@@ -506,7 +506,7 @@ (let ((m (char-code char))) (or (<= (char-code #\A) m (char-code #\Z)) #+(and unicode (not unicode-bootstrap)) - (and (> m c::+ascii-limit+) + (and (> m lisp::+ascii-limit+) (= (unicode-category m) +unicode-category-title+)))))

(defun string-capitalize-unicode (string &key (start 0) end (casing :simple))

===================================== src/compiler/srctran.lisp ===================================== @@ -21,11 +21,6 @@ (in-package "C") (intl:textdomain "cmucl")

-(defconstant +ascii-limit+ - 127 - "A character code strictly larger than this is handled using Unicode - rules.") - ;;; Source transform for Not, Null -- Internal ;;; ;;; Convert into an IF so that IF optimizations will eliminate redundant @@ -1814,8 +1809,7 @@ (round-it pos)))))))

(defun round-derive-type-quot (number-type divisor-type) - (let* ((rem-type (rem-result-type number-type divisor-type)) - (number-interval (numeric-type->interval number-type)) + (let* ((number-interval (numeric-type->interval number-type)) (divisor-interval (numeric-type->interval divisor-type))) (let ((quot (round-quotient-bound (interval-div number-interval @@ -1824,9 +1818,7 @@ ,(or (interval-high quot) '*))))))

(defun round-derive-type-rem (number-type divisor-type) - (let* ((rem-type (rem-result-type number-type divisor-type)) - (number-interval (numeric-type->interval number-type)) - (divisor-interval (numeric-type->interval divisor-type))) + (let* ((rem-type (rem-result-type number-type divisor-type))) (multiple-value-bind (class format) (ecase rem-type (integer @@ -1840,13 +1832,6 @@ (values 'float nil)) (real (values nil nil))) - #+nil - (when (member rem-type '(float single-float double-float - #+long-float long-float - #+double-double double-double-float)) - (setf rem (interval-func #'(lambda (x) - (coerce x rem-type)) - rem))) (make-numeric-type :class class :format format :low nil

===================================== src/i18n/locale/cmucl.pot ===================================== @@ -5443,6 +5443,12 @@ msgstr "" msgid "The upper exclusive bound on the value of a Unicode codepoint" msgstr ""

+#: src/code/char.lisp +msgid "" +"A character code strictly larger than this is handled using Unicode\n" +" rules." +msgstr "" + #: src/code/char.lisp msgid "" "Number of bits used for the index of the second stage table of the\n" @@ -19149,12 +19155,6 @@ msgstr "" msgid "FOREIGN-SYMBOL-ADDRESS flavor ~S is not :CODE or :DATA" msgstr ""

-#: src/compiler/srctran.lisp -msgid "" -"A character code strictly larger than this is handled using Unicode\n" -" rules." -msgstr "" - #: src/compiler/srctran.lisp msgid "Function doesn't have fixed argument count." msgstr ""

View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/92732c62ca7118fa87c172c...