32bit compiler fixes - gcl.git - GNU Common Lisp

diff --git a/gcl/cmpnew/gcl_cmptop.lsp b/gcl/cmpnew/gcl_cmptop.lsp
index 33c4c7ea7..41cc03c02 100644
--- a/gcl/cmpnew/gcl_cmptop.lsp
+++ b/gcl/cmpnew/gcl_cmptop.lsp

@@ -823,7 +823,7 @@

((cons (eql vv) t) (fm-to-string (cadr form)))

((cons (member char-value fixnum-value character-value) t) (fm-to-string (caddr form)))

((eql most-negative-fixnum) #.(string-concatenate "(" (write-to-string (1+ most-negative-fixnum)) "- 1)"))

- (integer (format nil "~a" form)); string character

+ (fixnum (format nil "~a" form)); string character

(float (format nil "~10,,,,,,'eG" form))

((complex float)

(string-concatenate "(" (fm-to-string (realpart form)) " + I * " (fm-to-string (imagpart form)) ")"))))

@@ -832,7 +832,7 @@

(string-concatenate

(cond ((member key '(:cnum :creal)) "")

((eq ft tt) "")

- ((equal ft t)

+ ((equal ft t)

(if *compiler-new-safety*

(let ((v (member key '(:char :int :fixnum))))

(if v (si::string-concatenate (setq p "object_to_") (strcat key))

@@ -1127,11 +1127,11 @@

(let ((x (position x +c-global-arg-types+ :test 'type<=)))

(if x (1+ x) 0))))

-(defun new-proclaimed-argd (args return)

+(defun new-proclaimed-argd (args return);FIXME room for more, but F_NARG_WIDTH = 6

(do* ((type (f-type return) (f-type (pop args)))

(i 0 (+ 2 i))

(ans type (logior ans (ash type i))))

- ((or (>= i 32) (null args)) (the (unsigned-byte 32) ans))))

+ ((or (>= i 14) (null args)) (the (unsigned-byte 15) ans))))

(defun type-f (x)

(declare (fixnum x))

@@ -1811,6 +1811,12 @@

;; ,@(mapcar (lambda (x y)

;; `(unbox ,(intern (symbol-name x) 'keyword) ,y)) args syms)))))))

+(defun c-key-rep (key)

+ (ecase key

+ ((:object :char :int :long :float :double :fixnum :void) (string-downcase key))

+ (:string "char *")

+ (:ustring "unsigned char *")))

+

(defmacro defentry (n args c &optional (lt t)

&aux (tsyms (load-time-value

(mapl (lambda (x) (setf (car x) (gensym "DEFENTRY")))

@@ -1824,9 +1830,9 @@

(tps (mapcar (lambda (x) (intern (string (if (consp x) (car x) x)) 'keyword)) args))

(decl (reduce (lambda (y x)

(strcat y (if (> (length y) 0) "," "")

- (cdr (assoc (get x 'cmp-lisp-type) +defentry-c-rep-alist+))))

+ (c-key-rep x)))

tps :initial-value ""))

- (decl (concatenate 'string (string-downcase rt) " " m "(" decl ");"))

+ (decl (concatenate 'string (c-key-rep rt) " " m "(" decl ");"))

(decl (if st "" decl))

(syms (mapcar (lambda (x) (declare (ignore x)) (pop tsyms)) args)))

`(defun ,n ,syms

diff --git a/gcl/cmpnew/gcl_cmptype.lsp b/gcl/cmpnew/gcl_cmptype.lsp
index 4d9d9f2e3..a55d3bc31 100644
--- a/gcl/cmpnew/gcl_cmptype.lsp
+++ b/gcl/cmpnew/gcl_cmptype.lsp

@@ -220,11 +220,6 @@

(list* nil +c-local-var-types-syms+))

`((object . "object "))))

-(defconstant +defentry-c-rep-alist+

- (mapcar (lambda (x &aux (z (assoc x *c-types*)))

- (cons (cadr z) (eighth z)))

- '(char #+64bit signed-int fixnum short-float long-float string t)))

-

(defconstant +cmp-type-alist+

(mapcar (lambda (x) (cons (cmp-norm-tp (car x)) (cdr x))) +type-alist+))

diff --git a/gcl/configure b/gcl/configure
index 945c9e993..214c4385d 100755
--- a/gcl/configure
+++ b/gcl/configure

@@ -8742,6 +8742,41 @@ esac

# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects

# declarations like 'int a3[[(sizeof (unsigned char)) >= 0]];'.

# This bug is HP SR number 8606223364.

+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking size of size_t" >&5

+printf %s "checking size of size_t... " >&6; }

+if test ${ac_cv_sizeof_size_t+y}

+then :

+ printf %s "(cached) " >&6

+else case e in #(

+ e) if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (size_t))" "ac_cv_sizeof_size_t" "$ac_includes_default"

+then :

+

+else case e in #(

+ e) if test "$ac_cv_type_size_t" = yes; then

+ { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5

+printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;}

+as_fn_error 77 "cannot compute sizeof (size_t)

+See 'config.log' for more details" "$LINENO" 5; }

+ else

+ ac_cv_sizeof_size_t=0

+ fi ;;

+esac

+fi

+ ;;

+esac

+fi

+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_size_t" >&5

+printf "%s\n" "$ac_cv_sizeof_size_t" >&6; }

+

+

+

+printf "%s\n" "#define SIZEOF_SIZE_T $ac_cv_sizeof_size_t" >>confdefs.h

+

+

+# The cast to long int works around a bug in the HP C Compiler

+# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects

+# declarations like 'int a3[[(sizeof (unsigned char)) >= 0]];'.

+# This bug is HP SR number 8606223364.

{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking size of long" >&5

printf %s "checking size of long... " >&6; }

if test ${ac_cv_sizeof_long+y}

diff --git a/gcl/configure.ac b/gcl/configure.ac
index c35373aa3..4c1cd3ed2 100644
--- a/gcl/configure.ac
+++ b/gcl/configure.ac

@@ -793,6 +793,7 @@ esac

# mechanism, in the PAGE macro. This offset is subtracted from

# addresses, in calculating a page for an address in the heap.

+AC_CHECK_SIZEOF(size_t,0)

AC_CHECK_SIZEOF(long,0)

AC_CHECK_SIZEOF(short,0)

AC_CHECK_SIZEOF(int,0)

diff --git a/gcl/h/compprotos.h b/gcl/h/compprotos.h
index 4008be19f..1347f02d3 100644
--- a/gcl/h/compprotos.h
+++ b/gcl/h/compprotos.h

@@ -85,7 +85,11 @@ char object_to_char(object);

void not_a_symbol(object);

object number_expt(object,object);

object fLrow_major_aref(object,fixnum);

+#if SIZEOF_SIZE_T == SIZEOF_INT

+void *alloca(unsigned);

+#else

void *alloca(unsigned long);

+#endif

object cmod(object);

object ctimes(object,object);

object cdifference(object,object);