1 |
|
;;-*-Lisp-*- |
2 |
;;; CMPVAR Variables. |
;;; CMPVAR Variables. |
3 |
;;; |
;;; |
4 |
;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa |
;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa |
165 |
(if (eq (var-loc var) 'OBJECT) |
(if (eq (var-loc var) 'OBJECT) |
166 |
'OBJECT |
'OBJECT |
167 |
(let ((type (var-type var))) |
(let ((type (var-type var))) |
168 |
(declare (object type)) |
(cond ((car (member type +c-local-var-types+ :test 'type<=))) |
|
(cond ((type>= 'fixnum type) 'FIXNUM) |
|
|
((type>= 'integer type) 'INTEGER) |
|
|
((type>= 'CHARACTER type) 'CHARACTER) |
|
|
((type>= 'long-float type) 'LONG-FLOAT) |
|
|
((type>= 'short-float type) 'SHORT-FLOAT) |
|
169 |
((and (boundp '*c-gc*) *c-gc* 'OBJECT)) |
((and (boundp '*c-gc*) *c-gc* 'OBJECT)) |
170 |
(t nil)))) |
(t nil)))) |
171 |
nil) |
nil) |
297 |
(let ((*inline-blocks* 0) (*restore-avma* *restore-avma*)) |
(let ((*inline-blocks* 0) (*restore-avma* *restore-avma*)) |
298 |
(save-avma '(nil integer)) |
(save-avma '(nil integer)) |
299 |
(wt-nl "SETQ_II(V"n",V" n"alloc,") |
(wt-nl "SETQ_II(V"n",V" n"alloc,") |
300 |
(wt-integer-loc loc (cons 'set-var var)) |
(wt-integer-loc loc) |
301 |
(wt "," (bignum-expansion-storage) ");") |
(wt "," (bignum-expansion-storage) ");") |
302 |
(close-inline-blocks)) |
(close-inline-blocks)) |
303 |
(return-from set-var nil)) |
(return-from set-var nil)) |
305 |
(wt ");"))) |
(wt ");"))) |
306 |
(t |
(t |
307 |
(wt-nl "V" (var-loc var) "= ") |
(wt-nl "V" (var-loc var) "= ") |
308 |
(case (var-kind var) |
(funcall (or (cdr (assoc (var-kind var) +wt-loc-alist+)) (baboon)) loc) |
309 |
(FIXNUM (wt-fixnum-loc loc)) |
(wt ";"))))) |
|
(CHARACTER (wt-character-loc loc)) |
|
|
(LONG-FLOAT (wt-long-float-loc loc)) |
|
|
(SHORT-FLOAT (wt-short-float-loc loc)) |
|
|
(OBJECT (wt-loc loc)) |
|
|
(t (baboon))) |
|
|
(wt ";")) |
|
|
))) |
|
310 |
|
|
311 |
(defun sch-global (name) |
(defun sch-global (name) |
312 |
(dolist* (var *undefined-vars* nil) |
(dolist* (var *undefined-vars* nil) |
435 |
(case (caar forms) |
(case (caar forms) |
436 |
(LOCATION (push (cons vref (caddar forms)) saves)) |
(LOCATION (push (cons vref (caddar forms)) saves)) |
437 |
(otherwise |
(otherwise |
438 |
(if (member (var-kind (car vref)) |
(if (assoc (var-kind (car vref)) +return-alist+) |
|
'(FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT OBJECT)) |
|
439 |
(let* ((kind (var-kind (car vref))) |
(let* ((kind (var-kind (car vref))) |
440 |
(cvar (cs-push (var-type (car vref)) t)) |
(cvar (cs-push (var-type (car vref)) t)) |
441 |
(temp (list 'var (make-var :kind kind :type (var-type (car vref)) :loc cvar) nil))) |
(temp (list 'var (make-var :kind kind :type (var-type (car vref)) :loc cvar) nil))) |