[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Gcl-commits] gcl debianchangelog cmpnew/gcl_cmpbind.lsp cmpn...
|
From: |
Camm Maguire |
|
Subject: |
[Gcl-commits] gcl debianchangelog cmpnew/gcl_cmpbind.lsp cmpn... |
|
Date: |
Wed, 21 Jun 2006 20:15:56 +0000 |
CVSROOT: /cvsroot/gcl
Module name: gcl
Changes by: Camm Maguire <camm> 06/06/21 20:15:56
Modified files:
debian : changelog
cmpnew : gcl_cmpbind.lsp gcl_cmpblock.lsp
gcl_cmpcall.lsp gcl_cmpfun.lsp gcl_cmpif.lsp
gcl_cmplam.lsp gcl_cmploc.lsp
gcl_cmpspecial.lsp gcl_cmptag.lsp
gcl_cmptop.lsp gcl_cmpvar.lsp
h : object.h
o : bind.c hash.d num_arith.c xdrfuns.c
Log message:
clean up latest gcc compiler warnings
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/gcl/debian/changelog?cvsroot=gcl&r1=1.1095&r2=1.1096
http://cvs.savannah.gnu.org/viewcvs/gcl/cmpnew/gcl_cmpbind.lsp?cvsroot=gcl&r1=1.5&r2=1.6
http://cvs.savannah.gnu.org/viewcvs/gcl/cmpnew/gcl_cmpblock.lsp?cvsroot=gcl&r1=1.5&r2=1.6
http://cvs.savannah.gnu.org/viewcvs/gcl/cmpnew/gcl_cmpcall.lsp?cvsroot=gcl&r1=1.15&r2=1.16
http://cvs.savannah.gnu.org/viewcvs/gcl/cmpnew/gcl_cmpfun.lsp?cvsroot=gcl&r1=1.31&r2=1.32
http://cvs.savannah.gnu.org/viewcvs/gcl/cmpnew/gcl_cmpif.lsp?cvsroot=gcl&r1=1.18&r2=1.19
http://cvs.savannah.gnu.org/viewcvs/gcl/cmpnew/gcl_cmplam.lsp?cvsroot=gcl&r1=1.15&r2=1.16
http://cvs.savannah.gnu.org/viewcvs/gcl/cmpnew/gcl_cmploc.lsp?cvsroot=gcl&r1=1.11&r2=1.12
http://cvs.savannah.gnu.org/viewcvs/gcl/cmpnew/gcl_cmpspecial.lsp?cvsroot=gcl&r1=1.14&r2=1.15
http://cvs.savannah.gnu.org/viewcvs/gcl/cmpnew/gcl_cmptag.lsp?cvsroot=gcl&r1=1.13&r2=1.14
http://cvs.savannah.gnu.org/viewcvs/gcl/cmpnew/gcl_cmptop.lsp?cvsroot=gcl&r1=1.39&r2=1.40
http://cvs.savannah.gnu.org/viewcvs/gcl/cmpnew/gcl_cmpvar.lsp?cvsroot=gcl&r1=1.18&r2=1.19
http://cvs.savannah.gnu.org/viewcvs/gcl/h/object.h?cvsroot=gcl&r1=1.64&r2=1.65
http://cvs.savannah.gnu.org/viewcvs/gcl/o/bind.c?cvsroot=gcl&r1=1.15&r2=1.16
http://cvs.savannah.gnu.org/viewcvs/gcl/o/hash.d?cvsroot=gcl&r1=1.26&r2=1.27
http://cvs.savannah.gnu.org/viewcvs/gcl/o/num_arith.c?cvsroot=gcl&r1=1.22&r2=1.23
http://cvs.savannah.gnu.org/viewcvs/gcl/o/xdrfuns.c?cvsroot=gcl&r1=1.9&r2=1.10
Patches:
Index: debian/changelog
===================================================================
RCS file: /cvsroot/gcl/gcl/debian/changelog,v
retrieving revision 1.1095
retrieving revision 1.1096
diff -u -b -r1.1095 -r1.1096
--- debian/changelog 21 Jun 2006 16:53:34 -0000 1.1095
+++ debian/changelog 21 Jun 2006 20:15:56 -0000 1.1096
@@ -187,8 +187,9 @@
* xgcl integration; smaller images; fewer recompiles; eq type
comparison;128M more heap
* Check for X headers before building xgcl
+ * clean up latest gcc compiler warnings
- -- Camm Maguire <address@hidden> Wed, 21 Jun 2006 16:53:21 +0000
+ -- Camm Maguire <address@hidden> Wed, 21 Jun 2006 20:15:41 +0000
gclcvs (2.7.0-53) unstable; urgency=low
Index: cmpnew/gcl_cmpbind.lsp
===================================================================
RCS file: /cvsroot/gcl/gcl/cmpnew/gcl_cmpbind.lsp,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -b -r1.5 -r1.6
--- cmpnew/gcl_cmpbind.lsp 17 Jun 2006 19:26:58 -0000 1.5
+++ cmpnew/gcl_cmpbind.lsp 21 Jun 2006 20:15:56 -0000 1.6
@@ -39,7 +39,7 @@
(clink (var-ref var))
(setf (var-ref-ccb var) (ccb-vs-push))))
(SPECIAL
- (wt-nl "bds_bind(VV[" (var-loc var) "],") (wt-vs (var-ref var))
+ (wt-nl "bds_bind(" (vv-str (var-loc var)) ",") (wt-vs (var-ref var))
(wt ");")
(push 'bds-bind *unwind-exit*))
(DOWN
@@ -77,7 +77,7 @@
(t
(wt-nl) (wt-vs (var-ref var)) (wt "= " loc ";"))))
(SPECIAL
- (wt-nl "bds_bind(VV[" (var-loc var) "]," loc ");")
+ (wt-nl "bds_bind(" (vv-str (var-loc var)) "," loc ");")
(push 'bds-bind *unwind-exit*))
(DOWN
@@ -125,4 +125,4 @@
(c2expr* init)))))
(defun set-bds-bind (loc vv)
- (wt-nl "bds_bind(VV[" vv "]," loc ");"))
+ (wt-nl "bds_bind(" (vv-str vv) "," loc ");"))
Index: cmpnew/gcl_cmpblock.lsp
===================================================================
RCS file: /cvsroot/gcl/gcl/cmpnew/gcl_cmpblock.lsp,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -b -r1.5 -r1.6
--- cmpnew/gcl_cmpblock.lsp 16 May 2006 16:38:45 -0000 1.5
+++ cmpnew/gcl_cmpblock.lsp 21 Jun 2006 20:15:56 -0000 1.6
@@ -168,8 +168,7 @@
(defun c2return-ccb (blk val)
(wt-nl "{frame_ptr fr;")
(wt-nl "fr=frs_sch(") (wt-ccb-vs (blk-ref-ccb blk)) (wt ");")
- (wt-nl "if(fr==NULL) FEerror(\"The block ~s is missing.\",1,VV["
- (blk-var blk) "]);")
+ (wt-nl "if(fr==NULL) FEerror(\"The block ~s is missing.\",1," (vv-str
(blk-var blk)) ");")
(let ((*value-to-go* 'top)) (c2expr* val))
(wt-nl "unwind(fr,Cnil);}")
)
Index: cmpnew/gcl_cmpcall.lsp
===================================================================
RCS file: /cvsroot/gcl/gcl/cmpnew/gcl_cmpcall.lsp,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -b -r1.15 -r1.16
--- cmpnew/gcl_cmpcall.lsp 17 Jun 2006 19:26:58 -0000 1.15
+++ cmpnew/gcl_cmpcall.lsp 21 Jun 2006 20:15:56 -0000 1.16
@@ -427,11 +427,11 @@
(cond
((null type)
(wt-nl1 "static void LnkT"
- num "(){ call_or_link(VV[" num "]," (if setf "1" "0") ",(void
**)(void *)&Lnk" num");}"
+ num "(){ call_or_link(" (vv-str num) "," (if setf "1" "0")
",(void **)(void *)&Lnk" num");}"
))
((eql type 'proclaimed-closure)
(wt-nl1 "static void LnkT" num
- "(ptr) object *ptr;{ call_or_link_closure(VV[" num "]," (if setf
"1" "0") ",(void **)(void *)&Lnk" num",(void **)(void *)&Lclptr" num");}"))
+ "(ptr) object *ptr;{ call_or_link_closure(" (vv-str num) "," (if
setf "1" "0") ",(void **)(void *)&Lnk" num",(void **)(void *)&Lclptr" num");}"))
(t
;;change later to include above.
;;(setq type (cdr (assoc type '((t . "object")(:btpr . "bptr")))))
@@ -441,12 +441,10 @@
(wt "(object first,...){"
(declaration-type (rep-type type)) "V1;"
"va_list ap;va_start(ap,first);V1=(" (declaration-type
(rep-type type)) ")call_"
- (if vararg "v" "") "proc_new(VV["
- (add-object name)"]," (if setf "1" "0") ",(void **)(void
*)&Lnk" num )
+ (if vararg "v" "") "proc_new(" (vv-str (add-object name))
"," (if setf "1" "0") ",(void **)(void *)&Lnk" num )
(or vararg (wt "," (proclaimed-argd args type)))
(wt ",first,ap);va_end(ap);return V1;}" )))
- (t (wt "(){return call_proc0(VV[" (add-object name)
- "]," (if setf "1" "0") ",(void **)(void *)&Lnk" num ");}"
))))
+ (t (wt "(){return call_proc0(" (vv-str (add-object name)) "," (if
setf "1" "0") ",(void **)(void *)&Lnk" num ");}" ))))
(t (error "unknown link type ~a" type)))
(setq name (function-string name))
(if (find #\/ name) (setq name (remove #\/ name)))
@@ -489,16 +487,16 @@
(let ((result
(case n
;(0 (list () t (flags ans set) (format nil "ifuncall0(VV[~d])" obj)))
- (1 (list '(t) t (flags ans set) (format nil "ifuncall1(VV[~d],(#0))"
obj)
+ (1 (list '(t) t (flags ans set) (format nil "ifuncall1(~a,(#0))"
(vv-str obj))
'ifuncall))
(2 (list '(t t) t (flags ans set)
- (format nil "ifuncall2(VV[~d],(#0),(#1))" obj)
+ (format nil "ifuncall2(~a,(#0),(#1))" (vv-str obj))
'ifuncall))
(t
(list (make-list n :initial-element t)
t (flags ans set)
- (format nil "ifuncall(VV[~a],~a~{,#~a~})"
- obj n
+ (format nil "ifuncall(~a,~a~{,#~a~})"
+ (vv-str obj) n
(dotimes (i n(nreverse res))
(push i res)))
'ifuncall)))))
@@ -511,7 +509,7 @@
(defun wt-simple-call (cfun base n &optional (vv-index nil))
(wt "simple_" cfun "(")
- (when vv-index (wt "VV[" vv-index "],"))
+ (when vv-index (wt (vv-str vv-index) ","))
(wt "base+" base "," n ")")
(base-used))
@@ -528,9 +526,9 @@
(if *safe-compile*
(wt-nl
temp
- "=symbol_function(VV[" (add-symbol (caddr funob)) "]);")
+ "=symbol_function(" (vv-str (add-symbol (caddr funob)))
");")
(wt-nl temp
- "=VV[" (add-symbol (caddr funob)) "]->s.s_gfdef;"))
+ "=" (vv-str (add-symbol (caddr funob)))
"->s.s_gfdef;"))
temp)))
(ordinary (let* ((temp (list 'vs (vs-push)))
(*value-to-go* temp))
@@ -559,9 +557,9 @@
;;; Want to set up the return catcher.
(unless loc
(setq loc (list 'vs (vs-push)))
- (wt-nl loc "=symbol_function(VV[" (add-symbol fname) "]);"))
+ (wt-nl loc "=symbol_function(" (vv-str (add-symbol fname)) ");"))
(push-args args)
- (wt-nl "funcall_with_catcher(VV[" (add-symbol fname) "]," loc ");")
+ (wt-nl "funcall_with_catcher(" (vv-str (add-symbol fname)) "," loc
");")
(unwind-exit 'fun-val nil fname))
(loc
;;; The function was already pushed.
@@ -578,8 +576,8 @@
(let ((base *vs*))
(setq loc (list 'vs (vs-push)))
(if *safe-compile*
- (wt-nl loc "=symbol_function(VV[" (add-symbol fname) "]);")
- (wt-nl loc "=(VV[" (add-symbol fname) "]->s.s_gfdef);"))
+ (wt-nl loc "=symbol_function(" (vv-str (add-symbol fname))
");")
+ (wt-nl loc "=(" (vv-str (add-symbol fname)) "->s.s_gfdef);"))
(push-args-lispcall args)
(cond ((or (eq *value-to-go* 'return)
(eq *value-to-go* 'top))
@@ -602,7 +600,7 @@
(eq *value-to-go* 'top))
(wt-nl "symlispcall")
(when inline-p (wt "_no_event"))
- (wt "(VV[" (add-symbol fname) "],base+" base ","
+ (wt "(" (vv-str (add-symbol fname)) ",base+" base ","
(length args) ");")
(base-used)
(unwind-exit 'fun-val nil fname))
Index: cmpnew/gcl_cmpfun.lsp
===================================================================
RCS file: /cvsroot/gcl/gcl/cmpnew/gcl_cmpfun.lsp,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -b -r1.31 -r1.32
--- cmpnew/gcl_cmpfun.lsp 17 Jun 2006 19:26:58 -0000 1.31
+++ cmpnew/gcl_cmpfun.lsp 21 Jun 2006 20:15:56 -0000 1.32
@@ -89,11 +89,11 @@
(cond ((eq *value-to-go* 'trash)
(cond ((characterp string)
(wt-nl "princ_char(" (char-code string))
- (if (null vv-index) (wt ",Cnil") (wt ",VV[" vv-index "]"))
+ (if (null vv-index) (wt ",Cnil") (wt "," (vv-str vv-index)))
(wt ");"))
((= (length string) 1)
(wt-nl "princ_char(" (char-code (aref string 0)))
- (if (null vv-index) (wt ",Cnil") (wt ",VV[" vv-index "]"))
+ (if (null vv-index) (wt ",Cnil") (wt "," (vv-str vv-index)))
(wt ");"))
(t
(wt-nl "princ_str(\"")
@@ -104,7 +104,7 @@
((char= char #\Newline) (wt "\\n"))
(t (wt char)))))
(wt "\",")
- (if (null vv-index) (wt "Cnil") (wt "VV[" vv-index "]"))
+ (if (null vv-index) (wt "Cnil") (wt "" (vv-str vv-index)))
(wt ");")))
(unwind-exit nil))
((eql string #\Newline) (c2call-global 'terpri (list stream) nil t))
Index: cmpnew/gcl_cmpif.lsp
===================================================================
RCS file: /cvsroot/gcl/gcl/cmpnew/gcl_cmpif.lsp,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -b -r1.18 -r1.19
--- cmpnew/gcl_cmpif.lsp 17 Jun 2006 19:26:58 -0000 1.18
+++ cmpnew/gcl_cmpif.lsp 21 Jun 2006 20:15:56 -0000 1.19
@@ -523,9 +523,9 @@
(case (car keylist)
((t) (wt "Ct"))
((nil) (wt "Cnil"))
- (otherwise (wt "VV[" (add-symbol (car keylist)) "]")))
+ (otherwise (wt (vv-str (add-symbol (car keylist))))))
(wt ")"))
- (t (wt "eql(V" cvar ",VV[" (car keylist) "])")))
+ (t (wt "eql(V" cvar "," (vv-str (car keylist)) ")")))
(when (< i 4) (wt-nl "|| "))
(pop keylist))
(wt ")")
@@ -539,9 +539,9 @@
(case (car keylist)
((t) (wt "Ct"))
((nil) (wt "Cnil"))
- (otherwise (wt "VV[" (add-symbol (car keylist)) "]")))
+ (otherwise (wt (vv-str (add-symbol (car keylist))))))
(wt ")"))
- (t (wt "!eql(V" cvar ",VV[" (car keylist) "])")))
+ (t (wt "!eql(V" cvar "," (vv-str (car keylist)) ")")))
(unless (endp (cdr keylist)) (wt-nl "&& "))
(pop keylist))
(wt ")")
Index: cmpnew/gcl_cmplam.lsp
===================================================================
RCS file: /cvsroot/gcl/gcl/cmpnew/gcl_cmplam.lsp,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -b -r1.15 -r1.16
--- cmpnew/gcl_cmplam.lsp 17 Jun 2006 19:26:58 -0000 1.15
+++ cmpnew/gcl_cmplam.lsp 21 Jun 2006 20:15:56 -0000 1.16
@@ -620,7 +620,7 @@
(if rest (wt ",TRUE,") (wt ",FALSE,"))
(if allow-other-keys (wt "TRUE,") (wt "FALSE,"))
(wt (length keywords))
- (dolist** (kwd keywords) (wt ",VV[" (add-symbol (car kwd)) "]"))
+ (dolist** (kwd keywords) (wt "," (vv-str (add-symbol (car kwd)))))
(wt ");")
;;; Bind required parameters.
@@ -961,8 +961,7 @@
(dolist** (kwd keywords)
(let ((cvar1 (cs-push t t)))
(wt-nl
- "{object V" cvar1 "=getf(V" cvar ",VV[" (add-symbol (car kwd))
- "],OBJNULL);")
+ "{object V" cvar1 "=getf(V" cvar "," (vv-str (add-symbol (car kwd)))
",OBJNULL);")
(wt-nl "if(V" cvar1 "==OBJNULL){")
(let ((*clink* *clink*)
(*unwind-exit* *unwind-exit*)
@@ -982,7 +981,7 @@
(not allow-other-keys))
(wt-nl "check_other_key(V" cvar "," (length keywords))
(dolist** (kwd keywords)
- (wt ",VV[" (add-symbol (car kwd)) "]"))
+ (wt "," (vv-str (add-symbol (car kwd)))))
(wt ");"))
(dolist** (aux auxs)
(c2dm-bind-init (car aux) (cadr aux)))
Index: cmpnew/gcl_cmploc.lsp
===================================================================
RCS file: /cvsroot/gcl/gcl/cmpnew/gcl_cmploc.lsp,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -b -r1.11 -r1.12
--- cmpnew/gcl_cmploc.lsp 17 Jun 2006 19:26:58 -0000 1.11
+++ cmpnew/gcl_cmploc.lsp 21 Jun 2006 20:15:56 -0000 1.12
@@ -184,7 +184,9 @@
(if type (wt "/* " (symbol-name type) " */"))
(wt "V" cvar))
-(defun wt-vv (vv) (wt "VV[" vv "]"))
+(defun vv-str (vv) (si::string-concatenate "((object)VV[" (write-to-string vv)
"])"))
+
+(defun wt-vv (vv) (wt (vv-str vv)))
(defun wt-fixnum-loc (loc)
(cond ((and (consp loc)
@@ -225,7 +227,7 @@
(eq (car loc) 'fixnum-value))))
(defun wt-fixnum-value (vv fixnum-value)
- (if vv (wt "VV[" vv "]")
+ (if vv (wt (vv-str vv))
(wt "small_fixnum(" fixnum-value ")")))
@@ -249,7 +251,7 @@
(defun wt-character-value (vv character-code)
(declare (ignore character-code))
- (wt "VV[" vv "]"))
+ (wt (vv-str vv)))
(defun wt-long-float-loc (loc)
(cond ((and (consp loc)
@@ -271,7 +273,7 @@
(defun wt-long-float-value (vv long-float-value)
(declare (ignore long-float-value))
- (wt "VV[" vv "]"))
+ (wt (vv-str vv)))
(defun wt-short-float-loc (loc)
(cond ((and (consp loc)
@@ -293,4 +295,4 @@
(defun wt-short-float-value (vv short-float-value)
(declare (ignore short-float-value))
- (wt "VV[" vv "]"))
+ (wt (vv-str vv)))
Index: cmpnew/gcl_cmpspecial.lsp
===================================================================
RCS file: /cvsroot/gcl/gcl/cmpnew/gcl_cmpspecial.lsp,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -b -r1.14 -r1.15
--- cmpnew/gcl_cmpspecial.lsp 17 Jun 2006 19:26:58 -0000 1.14
+++ cmpnew/gcl_cmpspecial.lsp 21 Jun 2006 20:15:56 -0000 1.15
@@ -161,8 +161,8 @@
(defun wt-symbol-function (vv)
(if *safe-compile*
- (wt "symbol_function(VV[" vv "])")
- (wt "(VV[" vv "]->s.s_gfdef)")))
+ (wt "symbol_function(" (vv-str vv) ")")
+ (wt "(" (vv-str vv) "->s.s_gfdef)")))
(defun wt-make-cclosure (cfun clink fname)
(wt-nl "make_cclosure_new(" (c-function-name "LC" cfun fname) ",Cnil,")
Index: cmpnew/gcl_cmptag.lsp
===================================================================
RCS file: /cvsroot/gcl/gcl/cmpnew/gcl_cmptag.lsp,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -b -r1.13 -r1.14
--- cmpnew/gcl_cmptag.lsp 17 Jun 2006 19:26:58 -0000 1.13
+++ cmpnew/gcl_cmptag.lsp 21 Jun 2006 20:15:56 -0000 1.14
@@ -245,7 +245,7 @@
(setf (tag-unwind-exit tag) label)
(when (tag-ref-clb tag)
(setf (tag-ref-clb tag) ref-clb)
- (wt-nl "if(eql(nlj_tag,VV[" (tag-var tag) "])) {")
+ (wt-nl "if(eql(nlj_tag," (vv-str (tag-var tag)) ")) {")
(wt-nl " ")
(reset-top)
(wt-nl " ")
@@ -276,7 +276,7 @@
(when (or (tag-ref-clb tag) (tag-ref-ccb tag))
(setf (tag-ref-clb tag) ref-clb)
(when (tag-ref-ccb tag) (setf (tag-ref-ccb tag) ref-ccb))
- (wt-nl "if(eql(nlj_tag,VV[" (tag-var tag) "])) {")
+ (wt-nl "if(eql(nlj_tag," (vv-str (tag-var tag)) ")) {")
(wt-nl " ")
(reset-top)
(wt-nl " ")
@@ -322,15 +322,14 @@
(if (tag-ref-ccb tag)
(wt-vs* (tag-ref-clb tag))
(wt-vs (tag-ref-clb tag)))
- (wt "),VV[" (tag-var tag) "]);"))
+ (wt ")," (vv-str (tag-var tag)) ");"))
(defun c2go-ccb (tag)
(wt-nl "{frame_ptr fr;")
(wt-nl "fr=frs_sch(") (wt-ccb-vs (tag-ref-ccb tag)) (wt ");")
- (wt-nl "if(fr==NULL)FEerror(\"The GO tag ~s is missing.\",1,VV["
- (tag-var tag) "]);")
+ (wt-nl "if(fr==NULL)FEerror(\"The GO tag ~s is missing.\",1," (vv-str
(tag-var tag)) ");")
(wt-nl "vs_base=vs_top;")
- (wt-nl "unwind(fr,VV[" (tag-var tag) "]);}"))
+ (wt-nl "unwind(fr," (vv-str (tag-var tag)) ");}"))
(defun wt-switch-case (x)
Index: cmpnew/gcl_cmptop.lsp
===================================================================
RCS file: /cvsroot/gcl/gcl/cmpnew/gcl_cmptop.lsp,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -b -r1.39 -r1.40
--- cmpnew/gcl_cmptop.lsp 20 Jun 2006 22:53:16 -0000 1.39
+++ cmpnew/gcl_cmptop.lsp 21 Jun 2006 20:15:56 -0000 1.40
@@ -313,7 +313,7 @@
;;; Initialization function.
(wt-nl1 "void init_" name "(){"
#+sgi3d "Init_Links ();"
- "do_init(VV);"
+ "do_init((void *)VV);"
"}")
@@ -381,14 +381,14 @@
;; last entry in the VV vector.
- (wt-h "static char * VVi[" (+ 1 *next-vv*) "]={")
+ (wt-h "static void * VVi[" (+ 1 *next-vv*) "]={")
(wt-h "#define Cdata VV[" *next-vv* "]")
(or *vaddress-list* (wt-h 0))
(do ((v (nreverse *Vaddress-List*) (cdr v)))
((null v) (wt-h "};"))
- (wt-h "(char *)(" (caar v) (if (cdr v) ")," ")")))
+ (wt-h "(void *)(" (caar v) (if (cdr v) ")," ")")))
- (wt-h "#define VV ((object *)VVi)")
+ (wt-h "#define VV (VVi)")
(wt-data-file)
@@ -1016,7 +1016,7 @@
(wt-nl "goto TTL;") (wt-nl1 "TTL:;"))
(dolist
(v specials)
- (wt-nl "bds_bind(VV[" (cdr v)"],V" (var-loc (car v))");")
+ (wt-nl "bds_bind(" (vv-str (cdr v)) ",V" (var-loc (car v))");")
(push 'bds-bind *unwind-exit*)
(setf (var-kind (car v)) 'SPECIAL)
(setf (var-loc (car v)) (cdr v)))
@@ -1690,7 +1690,7 @@
(si:putprop 'dbind 'set-dbind 'set-loc)
(defun set-dbind (loc vv)
- (wt-nl "VV[" vv "]->s.s_dbind = " loc ";"))
+ (wt-nl (vv-str vv) "->s.s_dbind = " loc ";"))
(defun t1clines (args)
(dolist** (s args)
@@ -1748,10 +1748,10 @@
((eq (caar s) 'quote)
(wt-nl1 (cadadr s))
(case (caadr s)
- (object (wt "=VV[" (cadar s) "];"))
+ (object (wt "=" (vv-str (cadar s)) ";"))
(otherwise
(wt "=object_to_" (string-downcase (symbol-name (caadr s)))
- "(VV[" (cadar s) "]);"))))
+ "(" (vv-str (cadar s)) ");"))))
(t (wt-nl1 "{vs_base=vs_top=old_top;")
(dolist** (arg (cdar s))
(wt-nl1 "vs_push(")
@@ -1765,17 +1765,15 @@
(wt ");"))
(cond ((setq fd (assoc (caar s) *global-funs*))
(cond (*compiler-push-events*
- (wt-nl1 "ihs_push(VV[" (add-symbol (caar s)) "]);")
+ (wt-nl1 "ihs_push(" (vv-str (add-symbol (caar s)))
");")
(wt-nl1 (c-function-name "L" (cdr fd) (caar s))
"();")
(wt-nl1 "ihs_pop();"))
(t (wt-nl1 (c-function-name "L" (cdr fd) (caar s))
"();"))))
(*compiler-push-events*
- (wt-nl1 "super_funcall(VV[" (add-symbol (caar s)) "]);"))
+ (wt-nl1 "super_funcall(" (vv-str (add-symbol (caar s)))
");"))
(*safe-compile*
- (wt-nl1 "super_funcall_no_event(VV[" (add-symbol (caar s))
- "]);"))
- (t (wt-nl1 "CMPfuncall(VV[" (add-symbol (caar s))
- "]->s.s_gfdef);"))
+ (wt-nl1 "super_funcall_no_event(" (vv-str (add-symbol
(caar s))) ");"))
+ (t (wt-nl1 "CMPfuncall(" (vv-str (add-symbol (caar s)))
"->s.s_gfdef);"))
)
(unless (endp (cdr s))
(wt-nl1 (cadadr s))
Index: cmpnew/gcl_cmpvar.lsp
===================================================================
RCS file: /cvsroot/gcl/gcl/cmpnew/gcl_cmpvar.lsp,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -b -r1.18 -r1.19
--- cmpnew/gcl_cmpvar.lsp 17 Jun 2006 19:26:58 -0000 1.18
+++ cmpnew/gcl_cmpvar.lsp 21 Jun 2006 20:15:56 -0000 1.19
@@ -247,12 +247,12 @@
(setf (var-kind var) 'object)
(wt-var var ccb))
(t (wt-vs (var-ref var)))))
- (SPECIAL (wt "(VV[" (var-loc var) "]->s.s_dbind)"))
+ (SPECIAL (wt "(" (vv-str (var-loc var)) "->s.s_dbind)"))
(REPLACED (wt (var-loc var)))
(DOWN (wt-down (var-loc var)))
(GLOBAL (if *safe-compile*
- (wt "symbol_value(VV[" (var-loc var) "])")
- (wt "(VV[" (var-loc var) "]->s.s_dbind)")))
+ (wt "symbol_value(" (vv-str (var-loc var)) ")")
+ (wt "(" (vv-str (var-loc var)) "->s.s_dbind)")))
(t (let ((z (cdr (assoc (var-kind var) +wt-c-var-alist+))))
(unless z (baboon))
(when (and (eq #tfixnum (var-kind var)) (zerop *space*))
@@ -280,11 +280,11 @@
((var-ref-ccb var) (wt-vs* (var-ref var)))
(t (wt-vs (var-ref var))))
(wt "= " loc ";"))
- (SPECIAL (wt-nl "(VV[" (var-loc var) "]->s.s_dbind)= " loc ";"))
+ (SPECIAL (wt-nl "(" (vv-str (var-loc var)) "->s.s_dbind)= " loc
";"))
(GLOBAL
(if *safe-compile*
- (wt-nl "setq(VV[" (var-loc var) "]," loc ");")
- (wt-nl "(VV[" (var-loc var) "]->s.s_dbind)= " loc ";")))
+ (wt-nl "setq(" (vv-str (var-loc var)) "," loc ");")
+ (wt-nl "(" (vv-str (var-loc var)) "->s.s_dbind)= " loc ";")))
(DOWN
(wt-nl "") (wt-down (var-loc var))
(wt "=" loc ";"))
Index: h/object.h
===================================================================
RCS file: /cvsroot/gcl/gcl/h/object.h,v
retrieving revision 1.64
retrieving revision 1.65
diff -u -b -r1.64 -r1.65
--- h/object.h 12 Apr 2006 13:36:30 -0000 1.64
+++ h/object.h 21 Jun 2006 20:15:56 -0000 1.65
@@ -688,9 +688,7 @@
};
/* flags */
#define GET_STREAM_FLAG(strm,name) ((strm)->sm.sm_flags & (1<<(name)))
-#define SET_STREAM_FLAG(strm,name,val) (val ? \
- ((strm)->sm.sm_flags |= (1<<(name))) : \
- ((strm)->sm.sm_flags &= ~(1<<(name))))
+#define SET_STREAM_FLAG(strm,name,val) {if (val) (strm)->sm.sm_flags |=
(1<<(name)); (strm)->sm.sm_flags &= ~(1<<(name));}
#define GCL_MODE_BLOCKING 1
#define GCL_MODE_NON_BLOCKING 0
Index: o/bind.c
===================================================================
RCS file: /cvsroot/gcl/gcl/o/bind.c,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -b -r1.15 -r1.16
--- o/bind.c 6 Oct 2005 20:30:08 -0000 1.15
+++ o/bind.c 21 Jun 2006 20:15:56 -0000 1.16
@@ -1078,7 +1078,7 @@
{int i=ks->n;
while (--i >=0)
{ks->keys[i].o = data->cfd.cfd_self[ ks->keys[i].i ];
- if (ks->defaults != (iobject *)Cstd_key_defaults)
+ if (ks->defaults != (void *)Cstd_key_defaults)
{int m=ks->defaults[i].i;
ks->defaults[i].o=
(m==-2 ? Cnil :
Index: o/hash.d
===================================================================
RCS file: /cvsroot/gcl/gcl/o/hash.d,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -b -r1.26 -r1.27
--- o/hash.d 6 Nov 2005 18:07:37 -0000 1.26
+++ o/hash.d 21 Jun 2006 20:15:56 -0000 1.27
@@ -62,6 +62,17 @@
#define MHSH(a_) ((a_) & ~(((unsigned long)1)<<(sizeof(a_)*CHAR_SIZE-1)))
+typedef union {/*FIXME size checks*/
+ float f;
+ unsigned long ul;
+} F2ul;
+
+typedef union {
+ double d;
+ unsigned long ul[2];
+} D2ul;
+
+
static unsigned long
hash_eql(object x) {
@@ -103,13 +114,18 @@
break;
case t_shortfloat: /*FIXME, sizeof int = sizeof float*/
- h=*((unsigned long *) &(sf(x)));
+ {
+ F2ul u;
+ u.f=sf(x);
+ return(u.ul);
+ }
break;
case t_longfloat:
{
- unsigned long *y = (unsigned long *) &lf(x);
- h= *y + *(y+1);
+ D2ul u;
+ u.d=lf(x);
+ return(u.ul[0]+u.ul[1]);
}
break;
Index: o/num_arith.c
===================================================================
RCS file: /cvsroot/gcl/gcl/o/num_arith.c,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -b -r1.22 -r1.23
--- o/num_arith.c 16 May 2006 16:46:30 -0000 1.22
+++ o/num_arith.c 21 Jun 2006 20:15:56 -0000 1.23
@@ -78,7 +78,7 @@
if (i==-1 || j<= (MOST_NEGATIVE_FIX/i))
goto FIX;
} else {
- if (0<-i && -i<= (MOST_POSITIVE_FIX/-j))
+ if (i>MOST_NEGATIVE_FIX && -i<= (MOST_POSITIVE_FIX/-j))
goto FIX;
}
}
Index: o/xdrfuns.c
===================================================================
RCS file: /cvsroot/gcl/gcl/o/xdrfuns.c,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -b -r1.9 -r1.10
--- o/xdrfuns.c 18 Sep 2005 02:48:59 -0000 1.9
+++ o/xdrfuns.c 21 Jun 2006 20:15:56 -0000 1.10
@@ -80,7 +80,7 @@
u_int tmp=elt->v.v_fillp;
if (tmp!=elt->v.v_fillp)
goto error;
- if(!xdr_array(xdrp,(char **)&elt->v.v_self,
+ if(!xdr_array(xdrp,(void *)&elt->v.v_self,
&tmp,
elt->v.v_dim,
aet_types[elt->v.v_elttype].size,
@@ -142,7 +142,7 @@
u_int tmp=elt->v.v_fillp;
if (tmp!=elt->v.v_fillp)
goto error;
- if(!xdr_array(xdrp,(char **)&elt->v.v_self,
+ if(!xdr_array(xdrp,(void *)&elt->v.v_self,
&tmp,
elt->v.v_dim,
aet_types[elt->v.v_elttype].size,
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Gcl-commits] gcl debianchangelog cmpnew/gcl_cmpbind.lsp cmpn...,
Camm Maguire <=