/[gcl]/gcl/cmpnew/gcl_cmpvar.lsp
ViewVC logotype

Diff of /gcl/cmpnew/gcl_cmpvar.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by camm, Fri Oct 10 02:54:46 2003 UTC revision 1.4 by camm, Mon Dec 1 17:00:53 2003 UTC
# Line 253  Line 253 
253             (wt "(V" (var-loc var) ")"))             (wt "(V" (var-loc var) ")"))
254          ))          ))
255    
256    ;; When setting bignums across setjmps, cannot use alloca as longjmp
257    ;; restores the C stack.  FIXME -- only need malloc when reading variable
258    ;; outside frame.  CM 20031201
259    (defmacro bignum-expansion-storage ()
260      `(if (and (boundp '*unwind-exit*) (member 'frame *unwind-exit*))
261           "malloc"
262         "alloca"))
263    
264  (defun set-var (loc var ccb)  (defun set-var (loc var ccb)
265    (unless (and (consp loc)    (unless (and (consp loc)
266                 (eq (car loc) 'var)                 (eq (car loc) 'var)
# Line 283  Line 291 
291    
292                   (var                   (var
293                    (case (var-kind (cadr loc))                    (case (var-kind (cadr loc))
294                      (integer (wt "SETQ_II(V"n",V"n"alloc,V" (var-loc (cadr loc))))                      (integer (wt "SETQ_II(V"n",V"n"alloc,V" (var-loc (cadr loc)) ","
295                                     (bignum-expansion-storage)))
296                      (fixnum  (wt "ISETQ_FIX(V"n",V"n"alloc,V" (var-loc (cadr loc))))                      (fixnum  (wt "ISETQ_FIX(V"n",V"n"alloc,V" (var-loc (cadr loc))))
297                      (otherwise (wt "SETQ_IO(V"n",V"n"alloc,"loc ))))                      (otherwise (wt "SETQ_IO(V"n",V"n"alloc,"loc ","
298                   (vs (wt "SETQ_IO(V"n",V"n"alloc,"loc ))                                     (bignum-expansion-storage)))))
299                     (vs (wt "SETQ_IO(V"n",V"n"alloc,"loc ","
300                             (bignum-expansion-storage)))
301                   (otherwise                   (otherwise
302                    (let ((*inline-blocks* 0) (*restore-avma* *restore-avma*))                    (let ((*inline-blocks* 0) (*restore-avma* *restore-avma*))
303                      (save-avma '(nil integer))                      (save-avma '(nil integer))
304                      (wt-nl "SETQ_II(V"n",V" n"alloc,")                      (wt-nl "SETQ_II(V"n",V" n"alloc,")
305                      (wt-integer-loc loc  (cons 'set-var var))                      (wt-integer-loc loc  (cons 'set-var var))
306                      (wt ");")                      (wt "," (bignum-expansion-storage) ");")
307                      (close-inline-blocks))                      (close-inline-blocks))
308                    (return-from set-var nil))                    (return-from set-var nil))
309                    )                    )

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26