From e4988d1f7c23647fa3ccf2407aa789dc13bbcd8c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Tue, 14 Feb 2023 11:42:20 +0100 Subject: [PATCH] cmp: don't USE the package EXT --- src/cmp/cmparray.lsp | 24 ++++++++++++------------ src/cmp/cmpc-wt.lsp | 2 +- src/cmp/cmpenv-api.lsp | 2 +- src/cmp/cmpmac.lsp | 4 ++-- src/cmp/cmpmap.lsp | 2 +- src/cmp/cmpnum.lsp | 12 ++++++------ src/cmp/cmpopt-bits.lsp | 8 ++++---- src/cmp/cmpopt-cons.lsp | 2 +- src/cmp/cmpopt-sequence.lsp | 14 +++++++------- src/cmp/cmpopt.lsp | 6 +++--- src/cmp/cmppackage.lsp | 3 ++- src/cmp/cmppass1-call.lsp | 4 ++-- src/cmp/cmppass1-special.lsp | 6 +++--- src/cmp/cmppass1-var.lsp | 8 ++++---- src/cmp/cmptables.lsp | 6 +++--- src/cmp/cmptype-assert.lsp | 10 +++++----- src/cmp/cmptype.lsp | 6 +++--- src/cmp/cmputil.lsp | 6 +++--- 18 files changed, 63 insertions(+), 62 deletions(-) diff --git a/src/cmp/cmparray.lsp b/src/cmp/cmparray.lsp index 191931b59..1a6540da8 100644 --- a/src/cmp/cmparray.lsp +++ b/src/cmp/cmparray.lsp @@ -80,8 +80,8 @@ ,%displaced-to ,%displaced-index-offset))) ;; Then we may fill the array with a given value (when initial-element-supplied-p - (setf form `(si::fill-array-with-elt ,form ,%initial-element 0 nil))) - (setf form `(truly-the (array ,guessed-element-type ,dimensions-type) + (setf form `(si:fill-array-with-elt ,form ,%initial-element 0 nil))) + (setf form `(ext:truly-the (array ,guessed-element-type ,dimensions-type) ,form)))) form) @@ -92,7 +92,7 @@ (defun expand-vector-push (whole env extend &aux (args (rest whole))) (declare (si::c-local) (ignore env)) - (with-clean-symbols (value vector index dimension) + (ext:with-clean-symbols (value vector index dimension) (when (or (eq (first args) 'value) ; No infinite recursion (not (policy-open-code-aref/aset))) (return-from expand-vector-push @@ -114,8 +114,8 @@ (declare (fixnum index dimension) (:read-only index dimension)) (cond ((< index dimension) - (sys::fill-pointer-set vector (truly-the fixnum (+ 1 index))) - (sys::aset vector index value) + (si:fill-pointer-set vector (ext:truly-the fixnum (+ 1 index))) + (si:aset vector index value) index) (t ,(if extend `(vector-push-extend value vector ,@(cddr args)) @@ -137,7 +137,7 @@ form)) (defun expand-aref (array indices env) - (with-clean-symbols (%array) + (ext:with-clean-symbols (%array) `(let ((%array ,array)) (declare (:read-only %array) (optimize (safety 0))) @@ -162,11 +162,11 @@ `(let* ((,%array ,array)) (declare (:read-only ,%array) (optimize (safety 0))) - (si::row-major-aset ,%array ,(expand-row-major-index %array indices env) ,value)))) + (si:row-major-aset ,%array ,(expand-row-major-index %array indices env) ,value)))) (define-compiler-macro array-row-major-index (&whole form array &rest indices &environment env) (if (policy-open-code-aref/aset env) - (with-clean-symbols (%array) + (ext:with-clean-symbols (%array) `(let ((%array ,array)) (declare (:read-only %array) (optimize (safety 0))) @@ -188,7 +188,7 @@ (check-vector-in-bounds ,a ,index) ,index))) (if (policy-type-assertions env) - (with-clean-symbols (%array-index) + (ext:with-clean-symbols (%array-index) `(let ((%array-index ,index)) (declare (:read-only %array-index)) ,(expansion a '%array-index))) @@ -207,7 +207,7 @@ for index in indices collect `(,(gentemp "DIM") (array-dimension-fast ,a ,i)))) (dim-names (mapcar #'first dims))) - (with-clean-symbols (%ndx-var %output-var %dim-var) + (ext:with-clean-symbols (%ndx-var %output-var %dim-var) `(let* (,@dims (%output-var 0)) (declare (type ext:array-index %output-var ,@dim-names) @@ -221,12 +221,12 @@ for dim-var in dim-names when (plusp i) collect `(setf %output-var - (truly-the ext:array-index (* %output-var ,dim-var))) + (ext:truly-the ext:array-index (* %output-var ,dim-var))) collect `(let ((%ndx-var ,index)) (declare (ext:array-index %ndx-var)) ,(and check `(check-index-in-bounds ,a %ndx-var ,dim-var)) (setf %output-var - (truly-the ext:array-index (+ %output-var %ndx-var))))) + (ext:truly-the ext:array-index (+ %output-var %ndx-var))))) %output-var)))) ;(trace c::expand-row-major-index c::expand-aset c::expand-aref) diff --git a/src/cmp/cmpc-wt.lsp b/src/cmp/cmpc-wt.lsp index 1a681455c..6e6d64e8b 100644 --- a/src/cmp/cmpc-wt.lsp +++ b/src/cmp/cmpc-wt.lsp @@ -178,7 +178,7 @@ :element-type 'base-char :adjustable t :fill-pointer 0)) - (stream (make-sequence-output-stream output :external-format format))) + (stream (ext:make-sequence-output-stream output :external-format format))) (write-string string stream) output)) diff --git a/src/cmp/cmpenv-api.lsp b/src/cmp/cmpenv-api.lsp index e2c88b19c..91f5c870a 100644 --- a/src/cmp/cmpenv-api.lsp +++ b/src/cmp/cmpenv-api.lsp @@ -49,7 +49,7 @@ the closure in let/flet forms for variables/functions it closes over." `(progn ,@(rest record-def))) record-lexenv env))) (setf definition - `(flet ((,(compiled-function-name record) + `(flet ((,(ext:compiled-function-name record) ,@record-def)) ,definition)))) ((and (listp record) (symbolp (car record))) diff --git a/src/cmp/cmpmac.lsp b/src/cmp/cmpmac.lsp index 82c46afd4..ed8ca3ec5 100644 --- a/src/cmp/cmpmac.lsp +++ b/src/cmp/cmpmac.lsp @@ -32,8 +32,8 @@ (declare (type (integer 0 1023) hash) (type (array t (*)) ,cache-name)) (if (and elt ,@(loop for arg in lambda-list - collect `(,test (pop (truly-the cons elt)) ,arg))) - (first (truly-the cons elt)) + collect `(,test (pop (ext:truly-the cons elt)) ,arg))) + (first (ext:truly-the cons elt)) (let ((output (,name ,@lambda-list))) (setf (aref ,cache-name hash) (list ,@lambda-list output)) output)))))))) diff --git a/src/cmp/cmpmap.lsp b/src/cmp/cmpmap.lsp index 7517d6891..16d40a03f 100644 --- a/src/cmp/cmpmap.lsp +++ b/src/cmp/cmpmap.lsp @@ -46,7 +46,7 @@ (MAPCAN (setf do-or-collect 'NCONC)) (MAPCON (setf in-or-on :ON do-or-collect 'NCONC))) (when (eq in-or-on :ON) - (setf args (mapcar #'(lambda (arg) `(checked-value list ,arg)) args))) + (setf args (mapcar #'(lambda (arg) `(ext:checked-value list ,arg)) args))) (when (eq do-or-collect :DO) (let ((var (gensym))) (setf list-1-form `(with ,var = ,(first args)) diff --git a/src/cmp/cmpnum.lsp b/src/cmp/cmpnum.lsp index 62c3938da..54a59fe67 100644 --- a/src/cmp/cmpnum.lsp +++ b/src/cmp/cmpnum.lsp @@ -23,12 +23,12 @@ (define-compiler-macro boole (&whole form op-code op1 op2) (or (and (constantp op-code *cmp-env*) (case (ext:constant-form-value op-code *cmp-env*) - (#. boole-clr `(progn (checked-value integer ,op1) (checked-value integer ,op2) 0)) - (#. boole-set `(progn (checked-value integer ,op1) (checked-value integer ,op2) -1)) - (#. boole-1 `(prog1 (checked-value integer ,op1) (checked-value integer ,op2))) - (#. boole-2 `(progn (checked-value integer ,op1) (checked-value integer ,op2))) - (#. boole-c1 `(prog1 (lognot ,op1) (checked-value integer ,op2))) - (#. boole-c2 `(progn (checked-value integer ,op1) (lognot ,op2))) + (#. boole-clr `(progn (ext:checked-value integer ,op1) (ext:checked-value integer ,op2) 0)) + (#. boole-set `(progn (ext:checked-value integer ,op1) (ext:checked-value integer ,op2) -1)) + (#. boole-1 `(prog1 (ext:checked-value integer ,op1) (ext:checked-value integer ,op2))) + (#. boole-2 `(progn (ext:checked-value integer ,op1) (ext:checked-value integer ,op2))) + (#. boole-c1 `(prog1 (lognot ,op1) (ext:checked-value integer ,op2))) + (#. boole-c2 `(progn (ext:checked-value integer ,op1) (lognot ,op2))) (#. boole-and `(logand ,op1 ,op2)) (#. boole-ior `(logior ,op1 ,op2)) (#. boole-xor `(logxor ,op1 ,op2)) diff --git a/src/cmp/cmpopt-bits.lsp b/src/cmp/cmpopt-bits.lsp index 6e622b957..88c7d42b3 100644 --- a/src/cmp/cmpopt-bits.lsp +++ b/src/cmp/cmpopt-bits.lsp @@ -30,7 +30,7 @@ (define-compiler-macro ldb (&whole whole bytespec integer) (if (inline-bytespec bytespec) - (with-clean-symbols (%pos %size) + (ext:with-clean-symbols (%pos %size) `(with-let*-type-check ((%size ,(second bytespec) unsigned-byte) (%pos ,(third bytespec) unsigned-byte)) (logand (lognot (ash -1 %size)) (ash ,integer (- %pos))))) @@ -43,7 +43,7 @@ (define-compiler-macro mask-field (&whole whole bytespec integer) (if (inline-bytespec bytespec) - (with-clean-symbols (%pos %size) + (ext:with-clean-symbols (%pos %size) `(with-let*-type-check ((%size ,(second bytespec) unsigned-byte) (%pos ,(third bytespec) unsigned-byte)) (logand (ash (lognot (ash -1 %size)) %pos) @@ -52,7 +52,7 @@ (define-compiler-macro dpb (&whole whole newbyte bytespec integer) (if (inline-bytespec bytespec) - (with-clean-symbols (%pos %size %mask) + (ext:with-clean-symbols (%pos %size %mask) `(with-let*-type-check ((%size ,(second bytespec) unsigned-byte) (%pos ,(third bytespec) unsigned-byte) (%mask (ash (lognot (ash -1 %size)) %pos) t)) @@ -62,7 +62,7 @@ (define-compiler-macro deposit-field (&whole whole newbyte bytespec integer) (if (inline-bytespec bytespec) - (with-clean-symbols (%pos %size %mask) + (ext:with-clean-symbols (%pos %size %mask) `(with-let*-type-check ((%size ,(second bytespec) unsigned-byte) (%pos ,(third bytespec) unsigned-byte) (%mask (ash (lognot (ash -1 %size)) %pos) t)) diff --git a/src/cmp/cmpopt-cons.lsp b/src/cmp/cmpopt-cons.lsp index 4dd6e2b0b..dba9e7649 100644 --- a/src/cmp/cmpopt-cons.lsp +++ b/src/cmp/cmpopt-cons.lsp @@ -22,7 +22,7 @@ (loop for v in values for value-and-type in arg-types collect (if (consp value-and-type) - `(checked-value ,(second value-and-type) ,v) + `(ext:checked-value ,(second value-and-type) ,v) v))) ,@inline-form)) diff --git a/src/cmp/cmpopt-sequence.lsp b/src/cmp/cmpopt-sequence.lsp index 43de356e0..e6f793572 100644 --- a/src/cmp/cmpopt-sequence.lsp +++ b/src/cmp/cmpopt-sequence.lsp @@ -41,7 +41,7 @@ #+(or) (define-compiler-macro si::make-seq-iterator (seq &optional (start 0)) - (with-clean-symbols (%seq %start) + (ext:with-clean-symbols (%seq %start) `(let ((%seq (optional-type-check ,seq sequence)) (%start ,start)) (cond ((consp %seq) @@ -53,7 +53,7 @@ #+(or) (define-compiler-macro si::seq-iterator-ref (seq iterator) - (with-clean-symbols (%seq %iterator) + (ext:with-clean-symbols (%seq %iterator) `(let* ((%seq ,seq) (%iterator ,iterator)) (declare (optimize (safety 0))) @@ -61,18 +61,18 @@ ;; Fixnum iterators are always fine (aref %seq %iterator) ;; Error check in case we may have been passed an improper list - (si:cons-car (checked-value cons %iterator)))))) + (si:cons-car (ext:checked-value cons %iterator)))))) #+(or) (define-compiler-macro si::seq-iterator-next (seq iterator) - (with-clean-symbols (%seq %iterator) + (ext:with-clean-symbols (%seq %iterator) `(let* ((%seq ,seq) (%iterator ,iterator)) (declare (optimize (safety 0))) - (if (si::fixnump %iterator) - (let ((%iterator (1+ (truly-the fixnum %iterator)))) + (if (ext:fixnump %iterator) + (let ((%iterator (1+ (ext:truly-the fixnum %iterator)))) (declare (fixnum %iterator)) - (and (< %iterator (length (truly-the vector %seq))) + (and (< %iterator (length (ext:truly-the vector %seq))) %iterator)) (si:cons-cdr %iterator))))) diff --git a/src/cmp/cmpopt.lsp b/src/cmp/cmpopt.lsp index b591d0ccc..f49f96fab 100644 --- a/src/cmp/cmpopt.lsp +++ b/src/cmp/cmpopt.lsp @@ -138,7 +138,7 @@ (type ,first ,var2)) (AND (TYPEP ,var1 ',first) (locally (declare (optimize (speed 3) (safety 0) (space 0))) - (setf ,var2 (truly-the ,first ,var1)) + (setf ,var2 (ext:truly-the ,first ,var1)) (AND ,@(expand-in-interval-p var2 rest))))))) ;; ;; Compound COMPLEX types. @@ -188,7 +188,7 @@ (list-var (gensym)) (typed-var (if (policy-assume-no-errors env) list-var - `(truly-the cons ,list-var)))) + `(ext:truly-the cons ,list-var)))) `(block nil (let* ((,list-var ,expression)) (si::while ,list-var @@ -351,7 +351,7 @@ (c-type (lisp-type->rep-type float))) `(let ((value ,value)) (declare (:read-only value)) - (compiler-typecase value + (ext:compiler-typecase value (,float value) (t (ffi:c-inline (value) (:object) ,c-type diff --git a/src/cmp/cmppackage.lsp b/src/cmp/cmppackage.lsp index 6f29de4ce..c04e8f213 100644 --- a/src/cmp/cmppackage.lsp +++ b/src/cmp/cmppackage.lsp @@ -16,7 +16,8 @@ (defpackage #:c (:nicknames #:compiler) - (:use #:cl #:ext) + (:use #:cl) + (:import-from #:ext #:install-c-compiler) (:export ;; Flags controlling the compiler behavior. #:*compiler-break-enable* diff --git a/src/cmp/cmppass1-call.lsp b/src/cmp/cmppass1-call.lsp index 859049d55..e0fbefa09 100644 --- a/src/cmp/cmppass1-call.lsp +++ b/src/cmp/cmppass1-call.lsp @@ -272,10 +272,10 @@ call-arguments-limit (+ (first requireds) (first optionals)))) (apply-constant-args-p (and apply-p (constantp apply-list) - (listp (constant-form-value apply-list)))) + (listp (ext:constant-form-value apply-list)))) (n-args-got-min (if apply-constant-args-p (+ (length arguments) - (length (constant-form-value apply-list))) + (length (ext:constant-form-value apply-list))) (length arguments))) (n-args-got-max (cond ((and apply-p (not apply-constant-args-p)) nil) ; unknown maximum number of arguments diff --git a/src/cmp/cmppass1-special.lsp b/src/cmp/cmppass1-special.lsp index 0fbd2f9a6..04e40a48c 100644 --- a/src/cmp/cmppass1-special.lsp +++ b/src/cmp/cmppass1-special.lsp @@ -32,7 +32,7 @@ (c1truly-the args)))) (defun c1truly-the (args) - (check-args-number 'TRULY-THE args 2 2) + (check-args-number 'ext:truly-the args 2 2) (let* ((form (c1expr (second args))) (the-type (first args)) type) @@ -43,7 +43,7 @@ form)) (defun c1compiler-let (args &aux (symbols nil) (values nil)) - (when (endp args) (too-few-args 'COMPILER-LET 1 0)) + (when (endp args) (too-few-args 'ext:compiler-let 1 0)) (dolist (spec (car args)) (cond ((consp spec) (cmpck (not (and (symbolp (car spec)) @@ -59,7 +59,7 @@ (setq symbols (nreverse symbols)) (setq values (nreverse values)) (setq args (progv symbols values (c1progn (cdr args)))) - (make-c1form 'COMPILER-LET args symbols values args)) + (make-c1form 'ext:compiler-let args symbols values args)) (defun c1function (args &aux fd) (check-args-number 'FUNCTION args 1 1) diff --git a/src/cmp/cmppass1-var.lsp b/src/cmp/cmppass1-var.lsp index 4a3f0bf4a..80b0b39bc 100644 --- a/src/cmp/cmppass1-var.lsp +++ b/src/cmp/cmppass1-var.lsp @@ -96,7 +96,7 @@ ((trivial-type-p type) (c1expr (first form))) (t - (c1expr `(checked-value ,type ,(first form))))))) + (c1expr `(ext:checked-value ,type ,(first form))))))) ;; :read-only variable handling. Beppe (when (read-only-variable-p name other-decls) (if (global-var-p var) @@ -309,7 +309,7 @@ (type (var-type name)) (form (c1expr (if (trivial-type-p type) form - `(checked-value ,type ,form))))) + `(ext:checked-value ,type ,form))))) (add-to-set-nodes name (make-c1form* 'SETQ :type (c1form-type form) :args name form))) @@ -356,7 +356,7 @@ (push vref vrefs) (push (c1expr (if (trivial-type-p type) form - `(checked-value ,type ,form))) + `(ext:checked-value ,type ,form))) forms)))) (defun c1multiple-value-bind (args) @@ -402,7 +402,7 @@ (let ((new-var (gensym))) (push new-var vars) (push new-var value-bindings) - (push `(setf ,var-or-form (checked-value ,type ,new-var)) storing-forms)))) + (push `(setf ,var-or-form (ext:checked-value ,type ,new-var)) storing-forms)))) (multiple-value-bind (setf-vars setf-vals stores storing-form get-form) (get-setf-expansion var-or-form *cmp-env*) (push (first stores) vars) diff --git a/src/cmp/cmptables.lsp b/src/cmp/cmptables.lsp index c009a8511..bcbd32e0d 100644 --- a/src/cmp/cmptables.lsp +++ b/src/cmp/cmptables.lsp @@ -152,7 +152,7 @@ '((ext:with-backend . c1with-backend) ; t1 (cl:defmacro . t1defmacro) - (si:compiler-let . c1compiler-let) + (ext:compiler-let . c1compiler-let) (cl:eval-when . c1eval-when) (cl:progn . c1progn) (cl:macrolet . c1macrolet) @@ -235,7 +235,7 @@ (cl:multiple-value-bind . c2multiple-value-bind) (cl:function . c2function) - (si:compiler-let . c2compiler-let) + (ext:compiler-let . c2compiler-let) (with-stack . c2with-stack) (stack-push-values . c2stack-push-values) @@ -256,7 +256,7 @@ )) (defconstant +t2-dispatch-alist+ - '((si:compiler-let . t2compiler-let) + '((ext:compiler-let . t2compiler-let) (cl:progn . t2progn) (ordinary . t2ordinary) (cl:load-time-value . t2load-time-value) diff --git a/src/cmp/cmptype-assert.lsp b/src/cmp/cmptype-assert.lsp index be8fc7cd6..591b7f2c4 100644 --- a/src/cmp/cmptype-assert.lsp +++ b/src/cmp/cmptype-assert.lsp @@ -75,7 +75,7 @@ (symbol-macro-p value)) ;; If multiple references to the value cost time and space, ;; or may cause side effects, we save it. - (with-clean-symbols (%asserted-value) + (ext:with-clean-symbols (%asserted-value) `(let* ((%asserted-value ,value)) (declare (:read-only %asserted-value)) ,(expand-type-assertion '%asserted-value type env compulsory)))) @@ -126,14 +126,14 @@ value type) (cmpdebug "Checking type of ~S to be ~S" value type)) (let ((full-check - (with-clean-symbols (%checked-value) + (ext:with-clean-symbols (%checked-value) `(let* ((%checked-value ,value)) (declare (:read-only %checked-value)) ,(expand-type-assertion '%checked-value type *cmp-env* nil) ,(if (null and-type) '%checked-value - `(truly-the ,type %checked-value)))))) - (make-c1form* 'CHECKED-VALUE + `(ext:truly-the ,type %checked-value)))))) + (make-c1form* 'ext:CHECKED-VALUE :type type :args type form (c1expr full-check))))))) @@ -149,7 +149,7 @@ expression, ensuring that it is satisfied." (when (and (policy-type-assertions env) (not (trivial-type-p type))) (cmpdebug "Checking type of ~A to be ~A" value type) - `(checked-value ,type ,value))) + `(ext:checked-value ,type ,value))) (defmacro type-assertion (&whole whole value type &environment env) "Generates a type check on an expression, ensuring that it is satisfied." diff --git a/src/cmp/cmptype.lsp b/src/cmp/cmptype.lsp index 828921372..664382292 100644 --- a/src/cmp/cmptype.lsp +++ b/src/cmp/cmptype.lsp @@ -119,7 +119,7 @@ ;; later due to this assertion... (setf (var-type var) t checks (list* `(type-assertion ,name ,type) checks) - new-auxs (list* `(truly-the ,type ,name) name new-auxs)) + new-auxs (list* `(ext:truly-the ,type ,name) name new-auxs)) ;; Or simply enforce the variable's type. (setf (var-type var) (type-and (var-type var) type)))) finally @@ -191,10 +191,10 @@ ((multiple-value-setq (valid value) (constant-value-p value env)) (si::maybe-quote value)) (t - (with-clean-symbols (%value) + (ext:with-clean-symbols (%value) `(let* ((%value ,value)) ,(type-error-check '%value (replace-invalid-types type)) - (truly-the ,type %value))))))) + (ext:truly-the ,type %value))))))) (defun replace-invalid-types (type) ;; Some types which are acceptable in DECLARE are not diff --git a/src/cmp/cmputil.lsp b/src/cmp/cmputil.lsp index 9b6a92f2e..e9e154136 100644 --- a/src/cmp/cmputil.lsp +++ b/src/cmp/cmputil.lsp @@ -270,13 +270,13 @@ (return nil)) (flag (setf flag nil - fast (cdr (truly-the cons fast)))) + fast (cdr (ext:truly-the cons fast)))) ((eq slow fast) (return nil)) (t (setf flag t - slow (cdr (truly-the cons slow)) - fast (cdr (truly-the cons fast))))) + slow (cdr (ext:truly-the cons slow)) + fast (cdr (ext:truly-the cons fast))))) finally (return l))) (defun check-args-number (operator args &optional (min 0) (max most-positive-fixnum))