369 |
(make-var |
(make-var |
370 |
:type type |
:type type |
371 |
:kind |
:kind |
372 |
(if (member type |
(let ((type (promoted-c-type type))) |
373 |
*special-types*) |
(if (member type |
374 |
type 'object) |
*special-types*) |
375 |
:loc (cdar *c-vars*)) |
type 'object)) |
376 |
|
:loc (cdar *c-vars*)) |
377 |
nil |
nil |
378 |
)))) |
)))) |
379 |
(t (list 'vs (vs-push)))))) |
(t (list 'vs (vs-push)))))) |
450 |
) |
) |
451 |
(t (push loc1 locs1)))) |
(t (push loc1 locs1)))) |
452 |
(push (car l) locs1))))) |
(push (car l) locs1))))) |
453 |
(list (inline-type (cadr ii)) |
|
454 |
(caddr ii) |
(let ((others (and (stringp fun) (consp (cadr ii)) (eq 'values (caadr ii)) |
455 |
fun |
(mapcar #'inline-type (cddadr ii))))) |
456 |
locs) |
(list (inline-type (cadr ii)) |
457 |
|
(caddr ii) |
458 |
|
(if others (cons fun others) fun) |
459 |
|
locs |
460 |
|
)) |
461 |
) |
) |
462 |
(defvar *inline-types* |
(defvar *inline-types* |
463 |
'((boolean . INLINE-COND) |
'((boolean . INLINE-COND) |
594 |
(si:putprop 'inline-long-float 'wt-inline-long-float 'wt-loc) |
(si:putprop 'inline-long-float 'wt-inline-long-float 'wt-loc) |
595 |
(si:putprop 'inline-short-float 'wt-inline-short-float 'wt-loc) |
(si:putprop 'inline-short-float 'wt-inline-short-float 'wt-loc) |
596 |
|
|
597 |
(defun wt-inline-loc (fun locs &aux (i 0) (max -1)) |
(defun wt-inline-loc (fun locs &aux (i 0) (max -1) (maxv 0)) |
598 |
(declare (fixnum i max)) |
(declare (fixnum i max maxv)) |
599 |
(cond ((stringp fun) |
(let* ((others (and (consp fun) (stringp (car fun)) (cdr fun))) |
600 |
|
(fun (if (and (consp fun) (stringp (car fun))) (car fun) fun))) |
601 |
|
(cond ((stringp fun) |
602 |
(when (char= (char (the string fun) 0) #\@) |
(when (char= (char (the string fun) 0) #\@) |
603 |
(setq i 1) |
(setq i 1) |
604 |
(do () |
(do () |
636 |
(cond ((>= n max) (setq max n))) |
(cond ((>= n max) (setq max n))) |
637 |
(wt-loc (nth n locs))))) |
(wt-loc (nth n locs))))) |
638 |
(incf i 2)) |
(incf i 2)) |
639 |
|
((char= char #\$) |
640 |
|
(let* ((n (- (char-code (char fun (1+ i))) #.(char-code #\1))) |
641 |
|
(pos (position #\$ fun :start (+ i 2))) |
642 |
|
(new-fun (subseq fun (+ i 2) pos)) |
643 |
|
(*value-to-go* (or (nth n *values-to-go*) |
644 |
|
(and (member *value-to-go* '(top return) :test #'eq) |
645 |
|
(list 'vs (vs-push))) |
646 |
|
'trash))) |
647 |
|
(set-loc (list (nth n others) (flags) new-fun locs)) |
648 |
|
(setf maxv (max maxv (1+ n))) |
649 |
|
(setf i (1+ pos)))) |
650 |
(t |
(t |
651 |
(princ char *compiler-output1*) |
(princ char *compiler-output1*) |
652 |
(incf i))))) |
(incf i))))) |
653 |
|
(setq *values-to-go* (nthcdr maxv *values-to-go*)) |
654 |
) |
) |
655 |
(t (apply fun locs)))) |
(t (apply fun locs))))) |
656 |
|
|
657 |
(defun wt-inline (side-effectp fun locs) |
(defun wt-inline (side-effectp fun locs) |
658 |
(declare (ignore side-effectp)) |
(declare (ignore side-effectp)) |