; Problem Set 12 Answers

; NOTE: This problem is NOT like the one I was trying to invent on the fly in
; class!  It is a completely different problem that still involves exceptions!

; Today in class we saw that the actual JVM specification for MONITOREXIT
; included some behavior that M5 doesn't model: MONITOREXIT can throw
; exceptions.

; Below I show a new M5-style specification of MONITOREXIT -- a specification
; more accurate for the JVM -- and ask you to change the semantics of our old
; MONITOREXIT to be this new semantics.  You might want to actually carry out
; your redefinition in ACL2 (or ACL2s).  To redefine a function in ACL2 (or
; ACL2s), first execute the command (REDEF).  Thereafter, you will be able to
; redefine any user-defined function.  You may assume that the built-in class
; table includes an entry for a class named "Exception".

; New specification for MONITOREXIT (modeled more closely on the JVM):

; (MONITOREXIT)

; Stack: ..., objectref  =>  ...

; Description:  objectref must be a reference to an object in the heap.  The
; current thread should be the owner of the monitor associated with the
; instance referenced by objectref and the counter indicating the number of
; times it has entered this monitor should be non-zero.  The thread decrements
; the counter and, if the value is then zero, releases the monitor.

; Exceptions:  If the object is not a reference or if it is a reference
; but the current thread does not own the monitor or the counter is zero,
; MONITOREXIT throws an "Exception".

; Problem: Change the semantics of our MONITOREXIT to implement this more
; accurate specification.  All that is required is for you to exhibit
; the new definition of execute-MONITOREXIT and any functions
; you redefine or introduce.

; Answer:

(include-book "irun")

(in-package "M5")

(defun refp (x)
  (and (consp x)
       (equal (car x) 'REF)))

(set-ignore-ok t)

(redef)

(defsem (MONITOREXIT)
  (let* ((ref (top -stk-))
         (obj (deref ref -hp-)))
    (cond
     ((or (not (refp ref))                                  ; These are the conditions
          (not (equal (getf "Object" "monitor" obj) id))    ; described above for triggering
          (zp (getf "Object" "mcount" obj)))                ; an exception.

; If an exception is to be triggered, we first must build an Exception object
; in the heap with a reference to the Exception on the stack.  We do that with
; execute-NEW and call the new state s1.

      (let* ((s1 (execute-NEW '(NEW "Exception") id s))

; Unfortunately, execute-NEW advances the pc past the MONITOREXIT and we must
; back it up to point to the MONITOREXIT since the exception table is sensitive
; to the pc.  We call that state s2.

             (s2 (modify id s1 :pc (- -pc- 1))))

; Now we reach into s2 and get the reference to the Exception (which is on top
; of the stk of the top-frame of s2) and use execute-THROW1 on s2 to compute
; the next state.  If it fails, we return s, which makes the whole thing a
; no-op.  That handles the case that there is no handler to catch an exception
; thrown here.

        (or (execute-THROW1 (top (stk (top-frame id s2)))
                            id s2)
            s)))

; Otherwise, the function is as before.

     ((unlockablep id ref -hp-)
      (modify id s
              :stk (pop -stk-)
              :hp (unlock id ref -hp-)))
     (t s))))

; Here is a test.  By stepping this state 5 times we (1) build an unlocked
; Object and (2) call MONITOREXIT on it.  If MONITOREXIT just did its normal
; thing, the code would then push a 0 and halt (by attempting to return from
; the top frame on the call stack).  But if the MONITOREXIT throws an exception,
; the exception table catches it and (3) pops the exception reference off the stack,
; (4) pushes a 1, and (5) halts.

(defconst *monitorexit-test-state*
  (make state
        :tt
        (list (make thread
                    :id 0
                    :cs
                    (push (make frame
                                :pc 0
                                :locs nil
                                :stk nil
                                :mloc '("Top" "main" 0))
                          nil)
                    :stat 'active
                    :ref nil))
        :hp nil
        :ct 
        (make-ct
         (list (make class
                     :name "Exception"
                     :supers '("Object")
                     :fields '("msg")
                     :methods nil)

               (make class
                     :name "Top"
                     :supers '("Object")
                     :fields '()
                     :methods (list
                               (make method
                                     :name "main"
                                     :formals nil
                                     :sync nil
                                     :code '((new "Object")    ;;; 0
                                             (monitorexit)     ;;; 1
                                             (const 0)         ;;; 2
                                             (xreturn)         ;;; 3
                                             (pop)             ;;; 4
                                             (const 1)         ;;; 5
                                             (xreturn)         ;;; 6
                                             )
                                     :xtbl
                                     '((0 1 4 "Exception")))))))))

; By running this 5 steps with irun you'll see it leaves a 1 on the stack and
; manufactures an Exception in the heap.

(irun *monitorexit-test-state*)