/[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.1.2.1 by camm, Sun Sep 14 02:30:34 2003 UTC revision 1.1.2.2 by camm, Mon Dec 1 16:50:00 2003 UTC
# Line 251  Line 251 
251             (wt "(V" (var-loc var) ")"))             (wt "(V" (var-loc var) ")"))
252          ))          ))
253    
254    ;; When setting bignums across setjmps, cannot use alloca as longjmp
255    ;; restores the C stack.  FIXME -- only need malloc when reading variable
256    ;; outside frame.  CM 20031201
257    (defmacro bignum-expansion-storage ()
258      `(if (and (boundp '*unwind-exit*) (member 'frame *unwind-exit*))
259           "malloc"
260         "alloca"))
261    
262  (defun set-var (loc var ccb)  (defun set-var (loc var ccb)
263    (unless (and (consp loc)    (unless (and (consp loc)
264                 (eq (car loc) 'var)                 (eq (car loc) 'var)
# Line 281  Line 289 
289    
290                   (var                   (var
291                    (case (var-kind (cadr loc))                    (case (var-kind (cadr loc))
292                      (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)) ","
293                                     (bignum-expansion-storage)))
294                      (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))))
295                      (otherwise (wt "SETQ_IO(V"n",V"n"alloc,"loc ))))                      (otherwise (wt "SETQ_IO(V"n",V"n"alloc,"loc ","
296                   (vs (wt "SETQ_IO(V"n",V"n"alloc,"loc ))                                     (bignum-expansion-storage)))))
297                     (vs (wt "SETQ_IO(V"n",V"n"alloc,"loc ","
298                             (bignum-expansion-storage)))
299                   (otherwise                   (otherwise
300                    (let ((*inline-blocks* 0) (*restore-avma* *restore-avma*))                    (let ((*inline-blocks* 0) (*restore-avma* *restore-avma*))
301                      (save-avma '(nil integer))                      (save-avma '(nil integer))
302                      (wt-nl "SETQ_II(V"n",V" n"alloc,")                      (wt-nl "SETQ_II(V"n",V" n"alloc,")
303                      (wt-integer-loc loc  (cons 'set-var var))                      (wt-integer-loc loc  (cons 'set-var var))
304                      (wt ");")                      (wt "," (bignum-expansion-storage) ");")
305                      (close-inline-blocks))                      (close-inline-blocks))
306                    (return-from set-var nil))                    (return-from set-var nil))
307                    )                    )

Legend:
Removed from v.1.1.2.1  
changed lines
  Added in v.1.1.2.2

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