Changeset 11819
 Timestamp:
 Mar 17, 2009, 4:46:31 PM (11 years ago)
 Location:
 branches/working0711/ccl
 Files:

 5 edited
Legend:
 Unmodified
 Added
 Removed

branches/working0711/ccl/compiler/X86/x862.lisp
r11701 r11819 223 223 (declaim (fixnum *x862vstack* *x862cstack*)) 224 224 225 225 226 226 227 227 … … 996 996 (values n constantalist)) 997 997 (declare (list things) 998 (fixnum n regno))998 (fixnum n #regno#)) 999 999 (let* ((thing (car things))) 1000 1000 (if (or (memq thing fcells) … … 1461 1461 1462 1462 (defun x862setvstack (new) 1463 (setq *x862vstack* new))1463 (setq *x862vstack* (or new 0))) 1464 1464 1465 1465 … … 5994 5994 (tail parsedops)) 5995 5995 (declare (dynamicextent parsedops) 5996 ( consparsedops tail))5996 (list parsedops tail)) 5997 5997 (dolist (op opvals (apply (cadr f) parsedops)) 5998 5998 (setq tail (cdr (rplaca tail (parseoperandform op t))))))) … … 6307 6307 (x862savenvrs seg pregs) 6308 6308 (dolist (pair reglocatives) 6309 ( declare (cons pair))6310 (let* ((constant (car pair))6309 (let* ((pair pair) 6310 (constant (car pair)) 6311 6311 (reg (cdr pair))) 6312 (declare (cons constant))6312 (declare (cons pair constant)) 6313 6313 (rplacd constant reg) 6314 6314 (! refconstant reg (x86immediatelabel (car constant)))))) … … 6343 6343 (argregnum (pop argregnumbers) (pop argregnumbers))) 6344 6344 ((null vars)) 6345 (declare (list vars) (fixnum argregnum))6345 (declare (list vars)) 6346 6346 (let* ((var (car vars))) 6347 6347 (when var 
branches/working0711/ccl/compiler/nxbasic.lisp
r11807 r11819 139 139 (let* ((safety (safetyoptimizequantity env))) 140 140 (or (eq safety 3) 141 (> safety (speedoptimizequantity env))))) ; thetypechecks141 (> safety (speedoptimizequantity env))))) ;declarationstypecheck 142 142 #'(lambda (env) 143 143 (neq (debugoptimizequantity env) 3)) ; inlineselfcalls … … 164 164 (forceboundpchecks nil fbp) 165 165 (allowconstantsubstitution nil acsp) 166 ( thetypechecks nil ttp))166 (declarationstypecheck nil dtp)) 167 167 (let ((p (copyuvector policy))) 168 168 (if atrp (setf (policy.allowtailrecursionelimination p) allowtailrecursionelimination)) … … 175 175 (if fbp (setf (policy.forceboundpchecks p) forceboundpchecks)) 176 176 (if acsp (setf (policy.allowconstantsubstitution p) allowconstantsubstitution)) 177 (if ttp (setf (policy.thetypechecks p) thetypechecks))177 (if dtp (setf (policy.declarationstypecheck p) declarationstypecheck)) 178 178 p)) 179 179 (defun %defaultcompilerpolicy () policy)) 
branches/working0711/ccl/compiler/nx0.lisp
r11807 r11819 320 320 (nxapplyenvhook policy.allowconstantsubstitution symbol value env)) 321 321 322 (defun nxthetypechecks (env) 323 (nxapplyenvhook policy.thetypechecks env)) 322 #BOOTSTRAPPED 323 (evalwhen (compile) 324 (unless (boundp 'policy.declarationstypecheck) 325 (load "ccl:library;lispequ.lisp"))) 326 327 (defun nxdeclarationstypecheck (env) 328 (nxapplyenvhook policy.declarationstypecheck env)) 329 324 330 325 331 #bccl … … 394 400 (defun nx1typedvarinitform (pending sym form &optional (env *nxlexicalenvironment*)) 395 401 (let* ((type t) 402 (formtype (dolist (decl (pendingdeclarationsvdecls pending) type) 403 (when (and (eq (car decl) sym) (eq (cadr decl) 'type)) 404 (setq type (nx1typeintersect sym (nxtargettype type) (cddr decl)))))) 396 405 (*nxformtype* (if (nxtrustdeclarations env) 397 (dolist (decl (pendingdeclarationsvdecls pending) type) 398 (when (and (eq (car decl) sym) (eq (cadr decl) 'type)) 399 (setq type (nx1typeintersect sym (nxtargettype type) (cddr decl))))) 406 formtype 400 407 t))) 408 (when (nxdeclarationstypecheck env) 409 (setq form `(the ,formtype ,form))) 401 410 (nx1typedform form env))) 402 411 … … 1906 1915 (if (eq type t) 1907 1916 form 1908 ( list(%nx1operator typedform) type form)))))1917 (makeacode (%nx1operator typedform) type form))))) 1909 1918 1910 1919 (defvar *formatargfunctions* '((format . 1) (formattostring . 1) (error . 0) (warn . 0) 
branches/working0711/ccl/compiler/nx1.lisp
r11701 r11819 44 44 typespec 45 45 (nx1transformedform transformed env) 46 (nx thetypechecksenv))))46 (nxdeclarationstypecheck env)))) 47 47 48 48 (defnx1 nx1structref structref (&whole whole structure offset) … … 1030 1030 (declaredtype (nxdeclaredtype sym))) 1031 1031 (let ((*nxformtype* declaredtype)) 1032 (when (nxdeclarationstypecheck env) 1033 (setq val `(the ,declaredtype ,val))) 1032 1034 (setq val (nx1typedform val env))) 1033 1035 (if (and info (neq info :special)) 
branches/working0711/ccl/library/lispequ.lisp
r11598 r11819 1559 1559 policy.opencodeinline 1560 1560 policy.inhibitsafetychecking 1561 policy. thetypechecks1561 policy.declarationstypecheck 1562 1562 policy.inlineselfcalls 1563 1563 policy.allowtransforms
Note: See TracChangeset
for help on using the changeset viewer.