- Timestamp:
- 07/29/10 18:27:10 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
r12806 r12832 1305 1305 (return-from walk-code)))))) 1306 1306 1307 (declaim (ftype (function ( ) t) analyze-stack))1308 (defun analyze-stack ( )1307 (declaim (ftype (function (t) t) analyze-stack)) 1308 (defun analyze-stack (code) 1309 1309 (declare (optimize speed)) 1310 (let* ((code *code*) 1311 (code-length (length code))) 1310 (let* ((code-length (length code))) 1312 1311 (declare (type vector code)) 1313 1312 (dotimes (i code-length) … … 1573 1572 1574 1573 (defun code-bytes (code) 1575 (let ((length 0)) 1574 (let ((length 0) 1575 labels ;; alist 1576 ) 1576 1577 (declare (type (unsigned-byte 16) length)) 1577 1578 ;; Pass 1: calculate label offsets and overall length. … … 1582 1583 (if (= opcode 202) ; LABEL 1583 1584 (let ((label (car (instruction-args instruction)))) 1584 (set label length)) 1585 (set label length) 1586 (setf labels 1587 (acons label length labels))) 1585 1588 (incf length (opcode-size opcode))))) 1586 1589 ;; Pass 2: replace labels with calculated offsets. … … 1609 1612 (setf (svref bytes index) byte) 1610 1613 (incf index))))) 1611 bytes)))1614 (values bytes labels)))) 1612 1615 1613 1616 (declaim (inline write-u1)) … … 1879 1882 (finalize-code) 1880 1883 (setf *code* (resolve-instructions *code*)) 1881 (setf (method-max-stack constructor) (analyze-stack ))1884 (setf (method-max-stack constructor) (analyze-stack *code*)) 1882 1885 (setf (method-code constructor) (code-bytes *code*)) 1883 1886 (setf (method-handlers constructor) (nreverse *handlers*)) … … 8206 8209 8207 8210 (setf *code* (resolve-instructions *code*)) 8208 (setf (method-max-stack execute-method) (analyze-stack ))8211 (setf (method-max-stack execute-method) (analyze-stack *code*)) 8209 8212 (setf (method-code execute-method) (code-bytes *code*)) 8210 8213
Note: See TracChangeset
for help on using the changeset viewer.