Changeset 4681


Ignore:
Timestamp:
11/08/03 19:08:36 (18 years ago)
Author:
piso
Message:

Work in progress.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/jvm.lisp

    r4680 r4681  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.19 2003-11-08 18:08:05 piso Exp $
     4;;; $Id: jvm.lisp,v 1.20 2003-11-08 19:08:36 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    406406  (list (ash n -8) (logand n #xff)))
    407407
    408 (defstruct instruction opcode args stack)
     408(defstruct instruction opcode args stack depth)
    409409
    410410(defun inst (opcode &optional args)
    411411  (unless (listp args)
    412412    (setq args (list args)))
    413   (make-instruction :opcode opcode :args args :stack nil))
     413  (make-instruction :opcode opcode :args args :stack nil :depth nil))
    414414
    415415(defun emit (instr &rest args)
     
    704704     0)
    705705    (t
    706      (format t "ANALYZE-STACK unsupported opcode ~S~%"
     706     (format t "STACK-EFFECT unsupported opcode ~S~%"
    707707             (instruction-opcode instruction))
    708708     0)))
     709
     710(defun walk-code (code start-index depth)
     711  (do* ((i start-index (1+ i))
     712        (limit (length code)))
     713       ((>= i limit) depth)
     714    (let ((instruction (svref code i)))
     715      (when (instruction-depth instruction)
     716        (return-from walk-code))
     717      (setf (instruction-depth instruction) depth)
     718      (setf depth (+ depth (instruction-stack instruction)))
     719      (if (branch-opcode-p (instruction-opcode instruction))
     720          (let ((label (car (instruction-args instruction))))
     721;;             (format t "target = ~S~%" target)
     722            (walk-code code (symbol-value label) depth)
     723            )
     724          ()))))
    709725
    710726(defun analyze-stack (code)
    711727  (sys::require-type code 'vector)
    712728  (dotimes (i (length code))
    713     (let ((instruction (svref code i)))
     729    (let* ((instruction (svref code i))
     730           (opcode (instruction-opcode instruction)))
     731      (when (eql opcode 202)
     732        (let ((label (car (instruction-args instruction))))
     733          (set label i)))
    714734      (unless (instruction-stack instruction)
    715         (setf (instruction-stack instruction)
    716               (stack-effect (instruction-opcode instruction)))))))
     735        (setf (instruction-stack instruction) (stack-effect opcode)))))
     736  (walk-code code 0 0)
     737  (let ((max-stack 0))
     738    (dotimes (i (length code))
     739      (let ((instruction (svref code i)))
     740        (setf max-stack (max max-stack (instruction-depth instruction)))))
     741;;     (format t "max-stack = ~D~%" max-stack)
     742    max-stack))
     743
     744(defvar *max-stack*)
    717745
    718746;; CODE is a list of INSTRUCTIONs.
     
    735763;;     (format t "branch-targets = ~S~%" branch-targets)
    736764
    737 ;;     ;; Remove labels that are never branched to.
     765;;     ;; Remove labels that are not used as branch targets.
    738766;;     (dotimes (i (length code))
    739767;;       (let ((instruction (svref code i)))
     
    762790
    763791;;   (setf code (coerce code 'list))
     792
     793  ;; FIXME Do stack analysis here!
     794  (setf *max-stack* (analyze-stack code))
    764795
    765796  (let ((code (resolve-opcodes code))
     
    783814          (unless (= (instruction-opcode instruction) 202) ; LABEL
    784815            (incf index (opcode-size (instruction-opcode instruction)))))))
    785 
    786     ;; FIXME Do stack analysis here!
    787     (analyze-stack code)
    788816
    789817    ;; Expand instructions into bytes, skipping LABEL pseudo-instructions.
     
    19892017    (emit 'areturn)
    19902018    (setf (method-code execute-method) (code-bytes *code*))
     2019    (setf (method-max-stack execute-method) *max-stack*)
    19912020    (setf (method-max-locals execute-method) *max-locals*)
    19922021
Note: See TracChangeset for help on using the changeset viewer.