; In *cmd*
; cd /u/moore/courses/cs378/jvm/spring-12/
; cat Point.java
; javac Point.java
; java Point
; javap -verbose Point
; cat ColoredPoint.java
; javac ColoredPoint.java
; java ColoredPoint
; javap -verbose ColoredPoint

; 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 2)
                (RETURN)
                (LOAD 0)
                (CONST "Red")
                (PUTFIELD ("ColoredPoint" "color"))
                (RETURN))))

(quote "Look at Point.java and ColoredPoint.java.")

(defconst *s*
  (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 "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 ("Point" "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 :mloc (mloc (top-frame 0 s)))
          '------------------------------------------------------
          (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 7)
(snap 8)
(snap (+ 8 13))

(snap 24)
(snap 25)
(snap (+ 25 24))

(pe 'execute-INVOKEVIRTUAL)
(pe 'execute-INVOKESTATIC)
(pe 'class-name-of-ref)
(pe 'execute-INVOKESPECIAL)

(defconst *Cons*
  (make class
        :name "Cons"
        :supers '("Object")
        :fields '("hd" "tl")
        :methods (list (make method
                             :name "main"
                             :formals nil
                             :sync nil
                             :code '((CONST 5)
                                     (INVOKESTATIC ("Cons" "circ" 1))
                                     (HALT)))
                       (make method
                             :name "circ"
                             :formals '(n)
                             :sync nil
                             :code '((LOAD 0)
                                     (IFGT 3)
                                     (CONST NIL)
                                     (XRETURN)
                                     (NEW "Cons")
                                     (DUP)
                                     (DUP)
                                     (DUP)
                                     (PUTFIELD ("Cons" "tl"))
                                     (STORE 1)
                                     (STORE 2)
                                     (LOAD 0)
                                     (CONST 1)
                                     (SUB)
                                     (STORE 0)
                                     (LOAD 0)
                                     (IFEQ 12)
                                     (NEW "Cons")
                                     (STORE 3)
                                     (LOAD 2)
                                     (LOAD 3)
                                     (PUTFIELD ("Cons" "tl"))
                                     (LOAD 3)
                                     (LOAD 1)
                                     (PUTFIELD ("Cons" "tl"))
                                     (LOAD 3)
                                     (STORE 2)
                                     (GOTO -16)
                                     (LOAD 1)
                                     (XRETURN))))))

(defconst *c* (make state
                    :tt (list (make thread
                                    :id 0
                                    :cs (push (make frame
                                                    :pc     0
                                                    :locs   nil
                                                    :stk    nil
                                                    :mloc   '("Cons" "main" 0))
                                              nil)
                        :stat 'active
                        :ref  nil))
        :hp nil
        :ct (make-ct (list *Cons*))))

(run (repeat 0 87) *c*)