; cd /u/moore/courses/cs378/jvm/spring-12/m5/
; acl2h536t

(include-book "m5")
(in-package "M5")

(defconst *Point.move*
  (make method
        :name "move"
        :formals '(dx dy)
        :sync nil
        :code '((load 0)
                (load 0)
                (getfield ("Point" "x"))
                (load 1)
                (add)
                (putfield ("Point" "x"))
                (load 0)
                (load 0)
                (getfield ("Point" "y"))
                (load 2)
                (add)
                (putfield ("Point" "y"))
                (return))))

(defconst *Point.dist*
  (make method
        :name "dist"
        :formals '(dx dy)
        :sync nil
        :code '((load 0)
                (getfield ("Point" "x"))
                (dup)
                (mul)
                (load 0)
                (getfield ("Point" "y"))
                (dup)
                (mul)
                (add)
                (xreturn))))

(defconst *ColoredPoint.move*
  (make method
        :name "move"
        :formals '(dx dy)
        :sync nil
        :code '((load 0)
                (load 1)
                (load 2)
                (invokespecial ("Point" "move" 2)) ; super.move(dx,dy);
                (load 0)
                (getfield ("Point" "x"))
                (iflt 5)
                (load 0)
                (getfield ("Point" "y"))
                (iflt 2)
                (return)
                (load 0)
                (const "Red")
                (putfield ("ColoredPoint" "color"))
                (return))))

(defconst *s*
  (make state
        :tt (list (make thread
                        :id 0
                        :cs (push (make frame
                                        :pc     0
                                        :locs   nil
                                        :stk    nil
                                        :mloc   '("ColoredPoint" "main" 1))
                                  nil)
                        :stat 'active
                        :ref  nil))
        :hp nil
        :ct (make-ct
             (list (make class
                         :name "Point"
                         :supers '("Object")
                         :fields '("x" "y")
                         :methods
                         (list
                          *Point.move*
                          *Point.dist*))
                   (make class
                         :name "ColoredPoint"
                         :supers '("Point" "Object")
                         :fields '("color")
                         :methods
                         (list *ColoredPoint.move*
                               (make method
                                     :name "main"
                                     :formals ()
                                     :sync nil
                                     :code '((NEW "Point")            ;  0
                                             (STORE 0)                ;  1
                                             (LOAD 0)                 ;  2
                                             (CONST 1)                ;  3
                                             (PUTFIELD ("Point" "x")) ;  4
                                             (LOAD 0)                 ;  5
                                             (GETFIELD ("Point" "x")) ;  6
                                             (POP)                    ;  7
                                             (LOAD 0)                 ;  8
                                             (CONST 2)                ;  9
                                             (PUTFIELD ("Point" "y")) ; 10
                                             (NEW "ColoredPoint")     ; 11
                                             (STORE 1)                ; 12
                                             (LOAD 1)                 ; 13
                                             (CONST "Blue")           ; 14
                                             (PUTFIELD ("ColoredPoint" "color")) ; 15
                                             (LOAD 1)                 ; 16
                                             (CONST 3)                ; 17
                                             (PUTFIELD ("ColoredPoint" "x")) ; 18
                                             (LOAD 1)                 ; 19
                                             (CONST 3)                ; 20
                                             (PUTFIELD ("Point" "x")) ; 21
                                             (LOAD 0)                 ; 22
                                             (LOAD 1)                 ; 23
                                             (PUTFIELD ("Point" "y")) ; 24
                                             ))))   
                   (make class
                         :name "Top"
                         :supers '("Object")
                         :fields nil
                         :methods
                         (list
                          (make method
                                :name "main"
                                :formals ()
                                :sync nil
                                :code '((NEW "Point")
                                        (STORE 0)
                                        (NEW "ColoredPoint")
                                        (STORE 1)
                                        (LOAD 0)
                                        (CONST -3)
                                        (CONST -4)
                                        (INVOKEVIRTUAL ("ColoredPoint" "move" 2))
                                        (LOAD 1)
                                        (CONST -7)
                                        (CONST -9)
                                        (INVOKEVIRTUAL ("Point" "move" 2))
                                        (HALT)))))))))

(defun snap (n)
  (let ((s (run (repeat 0 n) *s*)))
    (list (list :locs (locs (top-frame 0 s)))
          '------------------------------------------------------
          (list :stk (stk (top-frame 0 s)))
          '------------------------------------------------------
          (list :hp (hp s))
          '------------------------------------------------------
          (list :pc--> (next-inst 0 s))
          '======================================================)))

(snap 0)
(snap 1)
(snap 4)
(snap 5)
(snap 6)
(snap 7)
(snap 10)
(snap 11)
(snap 12)
(snap 15)
(snap 16)
(snap 18)
(quote "Note: this is a completely erroneous behavior from the perspective of the JVM.
Field descriptors should be of the form (class field) where field is an immediate 
field of class.  But x is not an immediate field of ColoredPoint, it is an immediate
field of Point.  The Java compiler would not produce the field descriptor 
(ColoredPoint x) it would produce (Point x).  M5 ``handles'' this erroneous descriptor
in a bogus way:  it creates an x field as an immediate field of ColoredPoint for this
particular instance.")
(snap 21)
(snap 22)

(snap 24)
(snap 25)

(pe 'execute-NEW)
(pe 'new-object)
(pe 'new-object1)
(pe 'new-object-immediate)
(pe 'bind-all)
(bind-all '("x" "y") 0)
(bind-all '("x" "y") '(11 12))
(pe 'new-ref)

(pe 'execute-GETFIELD)
(pe 'deref)
(pe 'getf)

(pe 'execute-PUTFIELD)
(pe 'putf)

(pe 'execute-INSTANCEOF)
(pe 'instanceofp)