[CommonLisp]ABCLでクラスファイルを作る

jnew-runtime-classを参考にしました。

(in-package :jvm)

(defun make-empty-class-file (class-name &optional (super-name "java.lang.Object"))
  (make-class-file (make-jvm-class-name class-name)
                   (make-jvm-class-name super-name)
                   '(:public)))

(defun create-class-bytes (class-file)
  (let ((stream (sys::%make-byte-array-output-stream)))
    (write-class-file class-file stream)
    (finish-output stream)
    (sys::%get-output-stream-bytes stream)))

(defun write-class-bytes (fname bytes)
  (with-open-file (f fname :direction :output :element-type '(unsigned-byte 8))
    (let ((n (java:jarray-length bytes)))
      (dotimes (i n)
        (write-byte (mod (java:jarray-ref bytes i) 256) f)))))

(defun create-helloworld-class (class-name fname)
  (let ((class-file (make-empty-class-file class-name)))
    (let* ((string-array-class (class-array (make-jvm-class-name "java.lang.String")))
           (method (make-jvm-method "main" :void `(,string-array-class) :flags '(:public :static))))
      (class-add-method class-file method)
      (with-code-to-method (class-file method)
        (emit-getstatic "java.lang.System" "out" (make-jvm-class-name "java.io.PrintStream"))
        (emit 'ldc (pool-string "Hello,World"))
        (emit-invokevirtual "java.io.PrintStream"
                            "println"
                            `(,(make-jvm-class-name "java.lang.String"))
                            :void)
        (emit 'return))
      (finalize-class-file class-file)
      (write-class-bytes fname (create-class-bytes class-file)))))


(create-helloworld-class "AbclHelloWorld" "AbclHelloWorld.class")

> java AbclHelloWorld
Hello,World