diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index 0c9907004..28c519dff 100755 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -1648,6 +1648,7 @@ cl_symbols[] = { {MP_ "SEMAPHORE-NAME" ECL_FUN("mp_semaphore_name", IF_MP(mp_semaphore_name), 1) ECL_VAR(MP_ORDINARY, OBJNULL)}, {MP_ "SEMAPHORE-WAIT-COUNT" ECL_FUN("mp_semaphore_wait_count", IF_MP(mp_semaphore_wait_count), 1) ECL_VAR(MP_ORDINARY, OBJNULL)}, {KEY_ "COUNT" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)}, +{KEY_ "TIMEOUT" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)}, {MP_ "BARRIER" ECL_FUN(NULL, NULL, -1) ECL_VAR(MP_ORDINARY, OBJNULL)}, {MP_ "MAKE-BARRIER" ECL_FUN("mp_make_barrier", IF_MP(mp_make_barrier), -2) ECL_VAR(MP_ORDINARY, OBJNULL)}, diff --git a/src/c/threads/mutex.d b/src/c/threads/mutex.d index a11a85e0c..be4c30a93 100755 --- a/src/c/threads/mutex.d +++ b/src/c/threads/mutex.d @@ -47,6 +47,8 @@ * */ +static void FEerror_not_a_recursive_lock(cl_object lock) ecl_attr_noreturn; + static void FEerror_not_a_recursive_lock(cl_object lock) { diff --git a/src/clos/fixup.lsp b/src/clos/fixup.lsp index b0aef5184..9ab0f07ce 100644 --- a/src/clos/fixup.lsp +++ b/src/clos/fixup.lsp @@ -246,7 +246,7 @@ their lambda lists ~A and ~A are not congruent." (do-function-to-method generic-function-method-class ((gf standard-generic-function))) (do-function-to-method (setf generic-function-name) - ((name t) (gf generic-function))) + (name (gf generic-function))) (do-function-to-method find-method-combination ((gf standard-generic-function) method-combination-type-name @@ -257,7 +257,7 @@ their lambda lists ~A and ~A are not congruent." (do-function-to-method compute-applicable-methods-using-classes ((gf standard-generic-function) classes)) (do-function-to-method compute-applicable-methods - ((gf standard-generic-function) args)) + ((gf standard-generic-function) arguments)) (do-function-to-method compute-effective-method ((gf standard-generic-function) method-combination applicable-methods))) diff --git a/src/cmp/cmppass1-top.lsp b/src/cmp/cmppass1-top.lsp index 582cfa895..afa374ad2 100644 --- a/src/cmp/cmppass1-top.lsp +++ b/src/cmp/cmppass1-top.lsp @@ -172,8 +172,7 @@ (when (eq (c1form-name fun-form) 'LOCALS) (let* ((function-list (c1form-arg 0 fun-form)) (fun-object (pop function-list)) - (form (c1form-arg 1 fun-form)) - (labels (c1form-arg 2 fun-form))) + (form (c1form-arg 1 fun-form))) (when (and ;; Only 1 function (null function-list) diff --git a/src/cmp/cmppass1-var.lsp b/src/cmp/cmppass1-var.lsp index 884dbdc4d..4a3f0bf4a 100644 --- a/src/cmp/cmppass1-var.lsp +++ b/src/cmp/cmppass1-var.lsp @@ -127,12 +127,11 @@ (c1let-optimize-read-only-vars vars forms body)) ;; Verify that variables are referenced and assign final boxed / unboxed type (mapc #'check-vref vars) - (let ((sp-change (some #'global-var-p vars))) - (make-c1form* let/let* - :type (c1form-type body) - :volatile (not (eql setjmps *setjmps*)) - :local-vars vars - :args vars forms body))) + (make-c1form* let/let* + :type (c1form-type body) + :volatile (not (eql setjmps *setjmps*)) + :local-vars vars + :args vars forms body)) (defun c1let-optimize-read-only-vars (all-vars all-forms body) (loop with base = (list body) @@ -147,10 +146,10 @@ (null (var-functions-setting var)) (not (global-var-p var))) when read-only-p - do (fix-read-only-variable-type var form rest-forms) + do (fix-read-only-variable-type var form) unless (and read-only-p (or (c1let-unused-variable-p var form) - (c1let-constant-value-p var form rest-vars rest-forms) + (c1let-constant-value-p var form) (c1let-constant-variable-p var form rest-vars rest-forms) #+(or) (c1let-can-move-variable-value-p var form rest-vars rest-forms))) @@ -158,7 +157,7 @@ collect form into used-forms finally (return (values used-vars used-forms)))) -(defun fix-read-only-variable-type (var form rest-forms) +(defun fix-read-only-variable-type (var form) (and-form-type (var-type var) form (var-name var) :unsafe "In LET body") (let ((form-type (c1form-primary-type form))) (setf (var-type var) form-type) @@ -177,7 +176,7 @@ (delete-c1forms form) t)) -(defun c1let-constant-value-p (var form rest-vars rest-forms) +(defun c1let-constant-value-p (var form) ;; (let ((v1 e1) (v2 e2) (v3 e3)) (expr e4 v2 e5)) ;; - v2 is a read only variable ;; - the value of e2 is not modified in e3 nor in following expressions diff --git a/src/cmp/cmptype-assert.lsp b/src/cmp/cmptype-assert.lsp index 8675accd2..be8fc7cd6 100644 --- a/src/cmp/cmptype-assert.lsp +++ b/src/cmp/cmptype-assert.lsp @@ -138,6 +138,7 @@ :args type form (c1expr full-check))))))) (defun c2checked-value (c1form type value let-form) + (declare (ignore c1form)) (c2expr (if (subtypep (c1form-primary-type value) type) value let-form))) diff --git a/src/cmp/cmpvar.lsp b/src/cmp/cmpvar.lsp index 12c9f8b83..e7c204948 100644 --- a/src/cmp/cmpvar.lsp +++ b/src/cmp/cmpvar.lsp @@ -234,7 +234,7 @@ (and record (not (var-p record))))) (defun variable-type-in-env (name &optional (env *cmp-env*)) - (let ((var (cmp-env-search-var name))) + (let ((var (cmp-env-search-var name env))) (cond ((var-p var) (var-type var)) ((si:get-sysprop name 'CMP-TYPE)) diff --git a/src/lsp/numlib.lsp b/src/lsp/numlib.lsp index cb8a0e228..ca23f0b1b 100644 --- a/src/lsp/numlib.lsp +++ b/src/lsp/numlib.lsp @@ -443,10 +443,13 @@ specified bits of INTEGER2 with the specified bits of INTEGER1." ;;; XXX long double may have 64, 80, 96 or 128 bits (possibly more). The layout ;;; in the memory is also an unknown, so we punt here. -- jd 2022-07-07 -(defun long-float-bits (num) - #+long-float (error "Operation not supported.") - #-long-float (double-float-bits num)) -(defun bits-long-float (num) +(defun long-float-bits (num) + #+long-float (declare (ignore num)) + #+long-float (error "Operation not supported.") + #-long-float (bits-double-float num)) + +(defun bits-long-float (num) + #+long-float (declare (ignore num)) #+long-float (error "Operation not supported.") #-long-float (bits-double-float num))