Introduced C-type declarations in the compiler.

src/CHANGELOG

@@ -6,6 +6,12 @@ ECL 13.7.1
 - DEFUN functions not defined as toplevel forms were also directly referenced
   other code in the same file.
 
+* Extensions:
+
+- In compiled code it is possible to declare variables to have a C type
+  such as in (declare (:double a)) and then the variable is enforced to
+  be unboxed to such type.
+
 ;;; Local Variables: ***
 ;;; mode:text ***
 ;;; fill-column:79 ***

src/cmp/cmpenv-declare.lsp

@@ -105,7 +105,9 @@ and a possible documentation string (only accepted when DOC-P is true)."
                      (policy-declaration-name-p decl-name))
                  (push decl others)
                  (multiple-value-bind (ok type)
-                     (valid-type-specifier decl-name)
+		     (if (machine-c-type-p decl-name)
+			 (values t decl-name)
+			 (valid-type-specifier decl-name))
                    (cmpassert ok "Unknown declaration specifier ~s"
                               decl-name)
                    (setf types (collect-declared type decl-args types))))))

src/cmp/cmptypes.lsp

@@ -51,8 +51,8 @@
 ;  ref-clb	;;; Cross local function reference: T or NIL.
 ;  read-nodes	;;; Nodes (c1forms) in which the reference occurs
   set-nodes	;;; Nodes in which the variable is modified
-  kind		;;; One of LEXICAL, CLOSURE, SPECIAL, GLOBAL, :OBJECT, :FIXNUM,
-  		;;; :CHAR, :DOUBLE, :FLOAT.
+  kind		;;; One of LEXICAL, CLOSURE, SPECIAL, GLOBAL, :OBJECT,
+                ;;; or some C representation type (:FIXNUM, :CHAR, etc)
   (function *current-function*)
 		;;; For local variables, in which function it was created.
 		;;; For global variables, it doesn't have a meaning.

src/cmp/cmpvar.lsp

@@ -72,6 +72,7 @@
   (mapcar #'first (var-read-nodes var)))
 
 (defun assert-var-ref-value (var)
+  #+debug-compiler
   (unless (let ((ref (var-ref var)))
 	    (or (> ref (/ most-positive-fixnum 2))
 		(= (var-ref var) (+ (length (var-read-nodes var))
@@ -172,18 +173,23 @@
   (cmpck (not (symbolp name)) "The variable ~s is not a symbol." name)
   (cmpck (constantp name) "The constant ~s is being bound." name)
   (let ((ignorable (cdr (assoc name ignores)))
-        type)
-    (setq type (if (setq type (assoc name types))
-                   (cdr type)
-                   'T))
+	(kind 'LEXICAL)  ; we rely on check-vref to fix it
+        (type (assoc name types)))
+    (cond ((null type)
+	   (setq type 'T))
+	  ((machine-c-type-p (setq type (cdr type)))
+	   (setf kind type
+		 type (rep-type->lisp-type type))))
     (cond ((or (member name specials) (special-variable-p name))
-           (unless type
+	   (unless (eq kind 'LEXICAL)
+	     (cmperr "Special variable ~A cannot be declared to have C type ~A"
+		     name type))
+           (when (eq type 'T)
 	     (setf type (or (get-sysprop name 'CMP-TYPE) 'T)))
 	   (c1make-global-variable name :kind 'SPECIAL :type type))
           (t
 	   (make-var :name name :type type :loc 'OBJECT
-		     :kind 'LEXICAL ; we rely on check-vref to fix it
-                     :ignorable ignorable
+		     :kind kind :ignorable ignorable
 		     :ref 0)))))
 
 (defun check-vref (var)
@@ -229,15 +235,20 @@
 	   ;; symbol-macrolet
 	   (baboon))
 	  (t
-	   (assert-var-ref-value var)
-	   (assert-var-not-ignored var)
-	   (when (eq (var-kind var) 'LEXICAL)
-	     (cond (ccb (setf (var-ref-clb var) nil ; replace a previous 'CLB
+	   (case (var-kind var)
+	     ((SPECIAL GLOBAL))
+	     ((CLOSURE))
+	     ((LEXICAL)
+	      (cond (ccb (setf (var-ref-clb var) nil ; replace a previous 'CLB
 			      (var-ref-ccb var) t
 			      (var-kind var) 'CLOSURE
 			      (var-loc var) 'OBJECT))
 		   (clb (setf (var-ref-clb var) t
 			      (var-loc var) 'OBJECT))))
+	     (t
+	      (when (or clb ccb)
+		(cmperr "Variable ~A declared of C type cannot be referenced across function boundaries."
+			(var-name var)))))
 	   var))))
 
 (defun push-vars (v)