Ignore:
Timestamp:
01/20/11 13:31:13 (12 years ago)
Author:
ehuelsmann
Message:

Final UNSAFE-P removal.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/unsafe-p-removal/abcl/src/org/armedbear/lisp/compiler-pass1.lisp

    r13160 r13161  
    11511151  (list 'TRULY-THE (%cadr form) (p1 (%caddr form))))
    11521152
    1153 (defvar *pass2-unsafe-p-special-treatment-functions*
    1154   '(
    1155      logand
    1156      logior
    1157      lognot
    1158      logxor
    1159 )
    1160 "The functions named in the list bound to this variable
    1161 need to be rewritten if UNSAFE-P returns non-NIL for their
    1162 argument list.
    1163 
    1164 All other function calls are handled by generic function calling
    1165 in pass2, which accounts for OPSTACK unsafety itself.")
    1166 
    1167 
    1168 
    1169 
    1170 (defknown unsafe-p (t) t)
    1171 (defun unsafe-p (args)
    1172   "Determines whether the args can cause 'stack unsafe situations'.
    1173 Returns T if this is the case.
    1174 
    1175 When a 'stack unsafe situation' is encountered, the stack cannot
    1176 be used for temporary storage of intermediary results. This happens
    1177 because one of the forms in ARGS causes a local transfer of control
    1178 - local GO instruction - which assumes an empty stack, or if one of
    1179 the args causes a Java exception handler to be installed, which
    1180 - when triggered - clears out the stack.
    1181 "
    1182   (cond ((node-p args)
    1183          (unsafe-p (node-form args)))
    1184         ((atom args)
    1185          nil)
    1186         (t
    1187          (case (%car args)
    1188            (QUOTE
    1189             nil)
    1190 ;;           (LAMBDA
    1191 ;;            nil)
    1192            ((RETURN-FROM GO CATCH THROW UNWIND-PROTECT BLOCK)
    1193             t)
    1194            (t
    1195             (dolist (arg args)
    1196               (when (unsafe-p arg)
    1197                 (return t))))))))
    1198 
    11991153(defknown p1-throw (t) t)
    12001154(defun p1-throw (form)
     
    12081162       ;;(funcall (lambda (...) ...) ...)
    12091163       (let ((op (car args)) (args (cdr args)))
    1210   (expand-function-call-inline form (cadr op) (copy-tree (cddr op))
    1211               args)))
     1164        (expand-function-call-inline form (cadr op) (copy-tree (cddr op))
     1165                                      args)))
    12121166      ((and (listp op) (eq (car op) 'lambda))
    12131167       ;;((lambda (...) ...) ...)
    12141168       (expand-function-call-inline form (cadr op) (copy-tree (cddr op)) args))
    1215       (t (if (and (member op *pass2-unsafe-p-special-treatment-functions*)
    1216                   (unsafe-p args))
    1217        (let ((arg1 (car args)))
    1218          (cond ((and (consp arg1) (eq (car arg1) 'GO))
    1219           arg1)
    1220          (t
    1221           (let ((syms ())
    1222           (lets ()))
    1223       ;; Preserve the order of evaluation of the arguments!
    1224       (dolist (arg args)
    1225         (cond ((and (constantp arg)
    1226                                       (not (node-p arg)))
    1227          (push arg syms))
    1228         ((and (consp arg) (eq (car arg) 'GO))
    1229          (return-from rewrite-function-call
    1230            (list 'LET* (nreverse lets) arg)))
    1231         (t
    1232          (let ((sym (gensym)))
    1233            (push sym syms)
    1234            (push (list sym arg) lets)))))
    1235       (list 'LET* (nreverse lets)
    1236             (list* (car form) (nreverse syms)))))))
    1237        form)))))
     1169      (t form))))
    12381170
    12391171(defknown p1-function-call (t) t)
Note: See TracChangeset for help on using the changeset viewer.