Changeset 15141


Ignore:
Timestamp:
11/01/19 15:53:04 (4 years ago)
Author:
Mark Evenson
Message:

compiler: fix stack inconsistency errors

(somewhat-functional-programmer) Mark

Lately I have been starting to dive deeper into Common Lisp and have started to
use ABCL more than SBCL or CCL lately. It is a very impressive project.

I want to post a patch for review/comments and hopefully have it be worthwhile
to eventually include it in ABCL. The patch attempts to fix a couple of stack
inconsistency bugs in the compiler. I came across the stack inconsistency issue
in one of my projects and started to try to find the root cause of the problem
based on a nice minimal reproduction of the bug found in
​https://github.com/armedbear/abcl/issues/69.

However, my particular bug was slightly different. It had to do with using a
return-from in the cleanup form of an unwind-protect. The following two forms
also result in a stack inconsistency problem (and are a more minimal
reproduction of the bug my code introduced):

(defun two-arg-fn (one two)

(format t "Two args: ~S and ~S~%" one two))

(let ((fn (compile nil '(lambda ()

(two-arg-fn

(block test-block

(unwind-protect

30

(return-from test-block 8)))

-1)))))

(funcall fn))

My patch handles both the github issue and the stack inconsistency in the form
above. It also fixes jvm::print-code to print string representations of values
from the constant pool which I found useful in debugging the output.

Anyhow, let me attempt to quickly summarize the stack inconsistency problem in
general:

  • Certain common lisp control flow forms (tagbody/go/unwind-protect/block/return-from/throw/catch) require the use of JVM exceptions to implement in bytecode
  • When the JVM throws an exception, the operand stack is cleared and the exception is pushed onto the operand stack (see jvms8, 6.5/athrow, p378)
  • Therefore, any form which pushes values onto the operand stack for further use is confounded when these control flow forms are child forms
  • To properly handle these alternate control flows we need to save the result of the control flow form to a local variable in the stack frame (distinct from the operand stack, and not destroyed by an exception (well at least not until the exception passes /out/ of the method) and then reload for use by the parent form to push on the operand stack

Take the case of the ash function (from the github issue). Bytecode for ash is
emitted from jvm::p2-ash. It compiles its arguments to the operand stack, and is
therefore vulnerable to the problem discussed above. Other low level functions
(like + for example in p2-plus) use the following forms to overcome this issue:
jvm::with-operand-accumulation and jvm::compile-operand. These forms save the
results of "unsafe" forms (opstack unsafe) to "registers" (local variables in
the stack frame). This technique allows for these complicated control flow forms
to be a child form of + with no issues, but not the ash function (which does not
do this). See my patch for how I added these already present
with-operand-accumulation and compile-operand forms to ash so it is no longer
vulnerable to stack inconsistency bugs.

Generally, function calls in ABCL are not vulnerable to these stack
inconsistency bugs. Function arguments are processed in jvm::process-args, and
in this function, the opstack safety of child forms is checked, and values are
saved to "registers" when a form is known to be unsafe. My case (the return-from
in the cleanup form of an unwind-protect) simply wasn't properly being marked as
opstack unsafe. I modified jvm::p1-unwind-protect to mark all direct children of
the unwind-protect as opstack unsafe, which eliminated my problem. I believe
there may have been confusion here in the code (speculation of course on my
part) of 'protected' form referring to the form actually protected by the
unwind-protect (which is totally different than being unsafe or needing opstack
/protection/) (or I'm misinterpreting this function and potentially causing
additional bugs!).

The only other item in my patch is fixing how bytecode is printed for debugging.
Basically, most items in a class constant pool are referenced with a 2 byte
index, but one (ldc) uses a one byte index). This has been accounted for in the
new function jvm::constant-pool-index.

Let me know what you think, and again please review, there aren't many lines
changed but I am new to the internals of the project. I think I ran all tests
(ant abcl.test) but while the ant task completed successfully, my output
complained of a missing dependency and I'm not sure what actually ran.

-Mark

The attached patch was produced against b3cfee6617e0c2c380d8675f3383d81e7758f358
from ​https://github.com/easye/abcl (latest master branch).

[jvms8] ​https://docs.oracle.com/javase/specs/jvms/se8/jvms8.pdf

Addresses <​https://github.com/armedbear/abcl/issues/69>.

In response to
<​https://mailman.common-lisp.net/pipermail/armedbear-devel/2019-May/003977.html>.

Location:
trunk/abcl/src/org/armedbear/lisp
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp

    r15098 r15141  
    674674      (let* ((block (make-unwind-protect-node))
    675675             (*block* block)
    676              ;; a bit of jumping through hoops...
    677              (unwinding-forms (p1-body (copy-tree (cddr form))))
    678              (unprotected-forms (p1-body (cddr form)))
     676
     677             ;; i believe this comment is misleading...
     678             ;;   - from an /opstack/ safety perspective, all forms (including cleanup) can have non-local returns
     679             ;; original comment: (and unwinding-forms and unprotected-forms were above this line previously, meaning they
     680             ;;                    did not fall under an unwind-protect /block/ and hence lead to stack inconsistency problems)
    679681             ;; ... because only the protected form is
    680682             ;; protected by the UNWIND-PROTECT block
    681683             (*blocks* (cons block *blocks*))
     684
     685             ;; this may be ok to have /above/ the blocks decl, since these should not be present inside the
     686             ;; exception handler and are therefore opstack safe
     687             ;;   my little test case passes either way (whether this is here or above)
     688             ;;  /but/ if the protected-form is marked as opstack unsafe, this should be too
     689             ;;     why is the protected form marked opstack unsafe?
     690             (unwinding-forms (p1-body (copy-tree (cddr form))))
     691
     692             ;; the unprotected-forms actually end up inside an exception handler and as such, /do/ need
     693             ;; to be marked opstack unsafe (so this is now below the *blocks* decl)
     694             ;;   (this name is now misleading from an opstack safety perspective)
     695             (unprotected-forms (p1-body (cddr form)))
     696
    682697             (protected-form (p1 (cadr form))))
    683698        (setf (unwind-protect-form block)

  • trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r15099 r15141  
    42434243                (fixnum-type-p type1)
    42444244                (fixnum-type-p result-type))
    4245            (compile-form arg1 'stack :int)
    42464245           (cond ((plusp constant-shift)
    4247                   (compile-form arg2 'stack :int)
    4248                   (maybe-emit-clear-values arg1 arg2)
     4246                  (with-operand-accumulation
     4247                      ((compile-operand arg1 :int)
     4248                       (compile-operand arg2 :int)
     4249                       (maybe-emit-clear-values arg1 arg2)))
    42494250                  (emit 'ishl))
    42504251                 ((minusp constant-shift)
    42514252                  (cond ((fixnump arg2)
    4252                          (emit-push-constant-int (- arg2)))
     4253                         (with-operand-accumulation
     4254                             ((compile-operand arg1 :int)
     4255                              (accumulate-operand (representation)
     4256                                (emit-push-constant-int (- arg2)))
     4257                              (maybe-emit-clear-values arg1))))
    42534258                        (t
    4254                          (compile-form arg2 'stack :int)
    4255                          (emit 'ineg)))
     4259                         (with-operand-accumulation
     4260                             ((compile-operand arg1 :int)
     4261                              (accumulate-operand (representation :unsafe-p t)
     4262                                (compile-form arg2 'stack :int)
     4263                                (emit 'ineg))
     4264                               (maybe-emit-clear-values arg1 arg2)))))
    42564265                  (maybe-emit-clear-values arg1 arg2)
    42574266                  (emit 'ishr))
    42584267                 ((zerop constant-shift)
     4268                  (compile-form arg1 'stack :int)
    42594269                  (compile-form arg2 nil nil))) ; for effect
    42604270           (convert-representation :int representation)
    … …  
    42654275                (java-long-type-p type1)
    42664276                (java-long-type-p result-type))
    4267            (compile-form arg1 'stack :long)
    42684277           (cond ((plusp constant-shift)
    4269                   (compile-form arg2 'stack :int)
    4270                   (maybe-emit-clear-values arg1 arg2)
     4278                  (with-operand-accumulation
     4279                      ((compile-operand arg1 :long)
     4280                       (compile-operand arg2 :int)
     4281                       (maybe-emit-clear-values arg1 arg2)))
    42714282                  (emit 'lshl))
    42724283                 ((minusp constant-shift)
    42734284                  (cond ((fixnump arg2)
    4274                          (emit-push-constant-int (- arg2)))
     4285                         (with-operand-accumulation
     4286                             ((compile-operand arg1 :long)
     4287                              (with-operand-accumulation (representation)
     4288                                (emit-push-constant-int (- arg2)))
     4289                              (maybe-emit-clear-values arg1))))
    42754290                        (t
    4276                          (compile-form arg2 'stack :int)
    4277                          (emit 'ineg)))
     4291                         (with-operand-accumulation
     4292                             ((compile-operand arg1 :long)
     4293                              (accumulate-operand (representation :unsafe-p t)
     4294                                (compile-form arg2 'stack :int)
     4295                                (emit 'ineg))
     4296                               (maybe-emit-clear-values arg1 arg2)))))
    42784297                  (maybe-emit-clear-values arg1 arg2)
    42794298                  (emit 'lshr))
    42804299                 ((zerop constant-shift)
     4300                  (compile-form arg1 'stack :long)
    42814301                  (compile-form arg2 nil nil))) ; for effect
    42824302           (convert-representation :long representation)
    … …  
    42944314                       (java-long-type-p type1)
    42954315                       (java-long-type-p result-type))
    4296                   (compile-forms-and-maybe-emit-clear-values arg1 'stack :long
    4297                                                              arg2 'stack :int)
     4316                  (with-operand-accumulation
     4317                      ((compile-operand arg1 :long)
     4318                       (compile-operand arg2 :int)
     4319                       (maybe-emit-clear-values arg1 arg2)))
    42984320                  (emit 'lshl)
    42994321                  (convert-representation :long representation))
    … …  
    43014323                       (java-long-type-p type1)
    43024324                       (java-long-type-p result-type))
    4303                   (compile-forms-and-maybe-emit-clear-values arg1 'stack :long
    4304                                                              arg2 'stack :int)
     4325                  (with-operand-accumulation
     4326                      ((compile-operand arg1 :long)
     4327                        (compile-operand arg2 :int)
     4328                        (maybe-emit-clear-values arg1 arg2)))
    43054329                  (emit 'ineg)
    43064330                  (emit 'lshr)
    43074331                  (convert-representation :long representation))
    43084332                 (t
    4309                   (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
    4310                                                              arg2 'stack :int)
     4333                  (with-operand-accumulation
     4334                      ((compile-operand arg1 nil)
     4335                       (compile-operand arg2 :int)
     4336                       (maybe-emit-clear-values arg1 arg2)))
    43114337                  (emit-invokevirtual +lisp-object+ "ash" '(:int) +lisp-object+)
    43124338                  (fix-boxing representation result-type)))

  • trunk/abcl/src/org/armedbear/lisp/jvm-instructions.lisp

    r14903 r15141  
    503503       (= (the fixnum (instruction-opcode (the instruction instruction))) 202)))
    504504
     505(defun constant-pool-index (instruction)
     506  "If an instruction references an item in the constant pool, return
     507   the index, otherwise return nil."
     508  ;; 1 byte index
     509  ;; 18 ldc
     510  ;;
     511  ;; 2 byte index
     512  ;; 178 getstatic
     513  ;; 179 putstatic
     514  ;; 180 getfield
     515  ;; 181 putfield
     516  ;; 182 invokevirtual
     517  ;; 183 invokespecial
     518  ;; 184 invokestatic
     519  ;; 185 invokeinterface
     520  ;; 187 new
     521  ;; 192 checkcast
     522  ;; 193 instanceof
     523  (when instruction
     524    (case (instruction-opcode instruction)
     525      (18 (first (instruction-args instruction)))
     526      ((19 20 178 179 180 181 182 183 184 185 187 192 193)
     527       (logior
     528        (ash (first (instruction-args instruction)) 8)
     529        (second (instruction-args instruction)))))))
     530
    505531(defun format-instruction-args (instruction pool)
    506   (if (memql (instruction-opcode instruction) '(18 19 20
    507                                                 178 179 180 181 182 183 184 185
    508                                                 187
    509                                                 192 193))
    510       (let ((*print-readably* nil)
    511             (*print-escape* nil))
     532  (let* ((*print-readably* nil)
     533         (*print-escape* nil)
     534         (pool-index (constant-pool-index instruction))
     535         (entry (when pool-index
     536                  (find-pool-entry pool pool-index))))
     537    (when entry
     538      (return-from
     539       format-instruction-args
    512540        (with-output-to-string (s)
    513541          (print-pool-constant pool
    514                                (find-pool-entry pool
    515                                                 (car (instruction-args instruction))) s
    516                                :package "org/armedbear/lisp")))
    517       (when (instruction-args instruction)
    518         (format nil "~S" (instruction-args instruction)))))
     542                               entry
     543                               s
     544                               :package "org/armedbear/lisp")))))
     545  (when (instruction-args instruction)
     546    (format nil "~S" (instruction-args instruction))))
    519547
    520548(defun print-code (code pool)
    … …  
    522550  (dotimes (i (length code))
    523551    (let ((instruction (elt code i)))
    524       (format t "~3D ~A ~19T~A ~A ~A~%"
     552      (format t "~3D ~A ~19T~A ~@[IStack: ~A~] ~@[IDepth: ~A~]~%"
    525553                    i
    526554                    (opcode-name (instruction-opcode instruction))
    527555                    (or (format-instruction-args instruction pool) "")
    528                     (or (instruction-stack instruction) "")
    529                     (or (instruction-depth instruction) "")))))
     556                    (instruction-stack instruction)
     557                    (instruction-depth instruction)))))
    530558
    531559(defun print-code2 (code pool)
    … …  
    859887(defun analyze-stack (code exception-entry-points)
    860888  (declare (optimize speed))
     889  ;;(print-code code *pool*)
    861890  (let* ((code-length (length code)))
    862891    (declare (type vector code))
Note: See TracChangeset for help on using the changeset viewer.