;; Java spec
(in-package #:jvmlib)

(def java-class-file
  (big-endian)
  (utf-mode-no-zeros)
  (assert u32 #xcafebabe "Magic number not found")
  (u16 minor-version)
  (u16 major-version)
  ((sparse-array constant-pool-entry :count u16 :start-at 1) constant-pool)
  (class-access-flags access-flags)
  (constant-class this-class)
  (constant-class super-class)
  ((array u16 u16) interfaces)
  ((array u16 field-info) fields)
  ((array u16 method-info) methods)
  ((array u16 attribute-info) attributes)
  )

(def constant-pool-entry
  (enum u8 tag
        (1 utf8
           ((utf-8 :bytes u16) value))
        (3 integer
           (s32 value))
        (4 float
           (f32 value))
        (5 long
           (s64 value)
           (sparse-post-offset 1))
        (6 double
           (f64 value)
           (sparse-post-offset 1))
        (7 class
           (u16 name-index))
        (8 string
           (u16 string-index))
        (9 fieldref
           (u16 class-index)
           (u16 name-and-type-index))
        (10 methodref
            (u16 class-index)
            (u16 name-and-type-index))
        (11 interface-methodref
            (u16 class-index)
            (u16 name-and-type-index))
        (12 name-and-type
            (u16 name-index)
            (u16 descriptor-index))
        (15 method-handle
            (u8 reference-kind)
            (u16 reference-index))
        (16 method-type
            (u16 descriptor-index))
        (18 invoke-dynamic
            (u16 bootstrap-method-attr-index)
            (u16 name-and-type-index))))

(def constant-value
  (u16 index)
  (implicit value (:find constant-pool index value)))

(def constant-class
  (u16 index)
  (implicit name (:find constant-pool (:find constant-pool index name-index) value)))

(def field-info
  (field-access-flags access-flags)
  (constant-value name)
  (constant-value descriptor)
  ((array u16 attribute-info) attributes))

(def method-info
  (method-access-flags access-flags)
  ;;(u16 name-index)
  (constant-value name)
  (constant-value descriptor)
  ((array u16 attribute-info) attributes))

(def attribute-info
  (constant-value attribute-name)
  ;;(u16 attribute-name-index)
  (size-of u32 ;; we can skip this span for now if something doesn't resolve yet
           (enum (:find attribute-name value) #|(:find constant-pool attribute-name-index value)|# type
                 ("ConstantValue" constant-value
                                  (constant-value value)
                                  ;;(u16 constant-value-index)
                                  )
                 ("Code" code
                         (u16 max-stack)
                         (u16 max-locals)
                         ((sparse-array jvm-op :bytes u32 :key rel-offset) code)
                         ((array u16
                                 (u16 start_pc)
                                 (u16 end_pc)
                                 (u16 handler_pc)
                                 (u16 catch_type)) exception-table)
                         ((array u16 attribute-info) attributes))
                 ("StackMapTable" stack-map-table
                                  ((array u16
                                          (enum u8 tag
                                                ((range 0 63) same
                                                 (enum-value offset-delta))
                                                ((range 64 127) same-locals-1-stack-item
                                                 ((- enum-value 64) offset-delta)
                                                 (verification-type-info stack))
                                                (247 same-locals-1-stack-item-extended
                                                     (u16 offset-delta)
                                                     (verification-type-info stack))
                                                ((range 248 250) chop
                                                 ((- 251 enum-value) k)
                                                 (u16 offset-delta))
                                                (251 same-frame-extended
                                                     (u16 offset-delta))
                                                ((range 252 254) append
                                                 (u16 offset-delta)
                                                 ((array (- enum-value 251) verification-type-info) locals))
                                                (255 full-frame
                                                     (u16 offset-delta)
                                                     ((array u16 verification-type-info) locals)
                                                     ((array u16 verification-type-info) stack))
                                                )) table))
                 ("Exceptions" exceptions
                               ((array u16 u16) exceptions))
                 ("InnerClasses" inner-classes
                                 ((array u16
                                         (u16 inner-class-info-index)
                                         (u16 outer-class-info-index)
                                         (u16 inner-name-index)
                                         (inner-class-access-flags inner-class-access-flags)) inner-classes))
                 ("EnclosingMethod" enclosing-method
                                    (u16 class-index)
                                    (u16 method-index))
                 ("Synthetic" synthetic)
                 ("Signature" signature
                              (u16 index))
                 ("SourceFile" source-file
                               (u16 index))
                 ("SourceDebugExtension" source-debug-extension
                                         (utf-8 debug-extension))
                 ("LineNumberTable" line-number-table
                                    ((array u16
                                            (u16 start-pc)
                                            (u16 line-number)) table))
                 ("LocalVariableTable" local-variable-table
                                       ((array u16
                                               (u16 start-pc)
                                               (u16 length)
                                               (u16 name-index)
                                               (u16 descriptor-index)
                                               (u16 index)) table))
                 ("LocalVariableTypeTable" local-variable-type-table
                                           ((array u16
                                                   (u16 start-pc)
                                                   (u16 length)
                                                   (u16 name-index)
                                                   (u16 signature-index)
                                                   (u16 index)) table))
                 ("Deprecated" deprecated)
                 ("RuntimeVisibleAnnotations" runtime-visible-annotations
                                              ((array u16 annotation) annotations))
                 ("RuntimeInvisibleAnnotations" runtime-invisible-annotations
                                                ((array u16 annotation) annotations))
                 ("RuntimeVisibleParameterAnnotations" runtime-visible-parameter-annotations
                                                       ((array u16 (array u16 annotation)) annotations))
                 ("RuntimeInvisibleParameterAnnotations" runtime-invisible-parameter-annotations
                                                         ((array u16 (array u16 annotation)) annotations))
                 ("AnnotationDefault" annotation-default
                                      (element-value default))
                 ("BootstrapMethods" bootstrap-methods
                                     ((array 2
                                             (u16 bootstrap-method-ref)
                                             (array (2 bootstrap-arguments)
                                                    u16)) bootstrap-methods))
                 )))

(def verification-type-info
  (enum u8 tag
        (0 top)
        (1 integer)
        (2 float)
        (4 long)
        (3 double)
        (5 null)
        (6 uninitialized-this)
        (7 object
           (u16 cpool-index))
        (8 uninitialized
           (u16 offset))))

(def annotation
  (u16 type-index)
  ((array u16
          (constant-value element-name-index)
          (element-value value)) element-value-pairs))

(def element-value
  (enum ascii-char tag
        ((one-of #\B #\C #\D #\F #\I #\J #\S #\Z #\s) const-value
         ;; TODO - this is hackish, but make sure it's reversible
         (enum-value type) ;;(implicit type value)?
         (u16 index))
        (#\e enum-const-value
             (u16 type-name-index)
             (u16 const-name-index))
        (#\c class-info
             (u16 index))
        (#\@ annotation
             (annotation value))
        (#\[ array
             ((array u16 element-value) values))))

(def class-access-flags
  (bitfield u16
            (#x0001 public)
            (#x0010 final)
            (#x0020 super) ;; conflicts with method
            (#x0200 interface)
            (#x0400 abstract)
            (#x1000 synthetic)
            (#x2000 annotation)
            (#x4000 enum)))

(def field-access-flags
  (bitfield u16
            (#x0001 public)
            (#x0002 private)
            (#x0004 protected)
            (#x0008 static)
            (#x0010 final)
            (#x0040 volatile)
            (#x0080 transient)
            (#x1000 synthetic)
            (#x4000 enum)))

(def method-access-flags
  (bitfield u16
            (#x0001 public)
            (#x0002 private)
            (#x0004 protected)
            (#x0008 static)
            (#x0010 final)
            (#x0020 synchronized) ;; conflicts with class
            (#x0040 bridge)
            (#x0080 varargs)
            (#x0100 native)
            (#x0400 abstract)
            (#x0800 strict)
            (#x1000 synthetic)))

(def inner-class-access-flags
  (bitfield u16
            (#x0001 public)
            (#x0002 private)
            (#x0004 protected)
            (#x0008 static)
            (#x0010 final)
            (#x0200 interface)
            (#x0400 abstract)
            (#x1000 synthetic)
            (#x2000 annotation)
            (#x4000 enum)))

(def signature-char
  (enum ascii-char type
        (#\I int)
        (#\J long)
        (#\V void)
        (#\) endlist
             (array-terminator))))

(def method-signature
  (literal ascii-char #\()
  ((sparse-array signature-char) parameter-types)
  (signature-char return-type))