file/write.lisp

   1 (in-package :avm2-compiler)
   2
   3 ;;; code to write out abc tag/hard coded simple .swf file to seekable
   4 ;;; stream or file
   5
   6
   7 ;; todo: range checks
   8
   9 ;;;;;;;;;;;;;;;;;;;;;
  10 ;;; low level writers
  11
  12 (defun write-u8 (byte &optional (stream *standard-output*))
  13   (write-byte byte stream))
  14
  15 (defun write-u16 (integer &optional (stream *standard-output*))
  16   (write-byte (ldb (byte 8 0) integer) stream)
  17   (write-byte (ldb (byte 8 8) integer) stream))
  18
  19 (defun write-u24 (integer &optional (stream *standard-output*))
  20   (write-byte (ldb (byte 8 0) integer) stream)
  21   (write-byte (ldb (byte 8 8) integer) stream)
  22   (write-byte (ldb (byte 8 16) integer) stream))
  23
  24 (defun write-u32-raw (integer &optional (stream *standard-output*))
  25   (write-byte (ldb (byte 8 0) integer) stream)
  26   (write-byte (ldb (byte 8 8) integer) stream)
  27   (write-byte (ldb (byte 8 16) integer) stream)
  28   (write-byte (ldb (byte 8 24) integer) stream))
  29
  30 (defun write-variable-length-encoded (integer &optional (stream *standard-output*))
  31   (loop
  32      for i = integer then i2
  33      for i2 = (ash i -7)
  34      for b = (ldb (byte 7 0) i)
  35      for done = (or (= i2 0) (= i2 -1))
  36      when (not done)
  37      do (setf b (logior #x80 b))
  38      do (write-byte b stream)
  39      until done))
  40
  41 (defun write-u30 (integer &optional (stream *standard-output*))
  42   (assert (<= 0 integer (expt 2 30)))
  43   (write-variable-length-encoded integer stream))
  44
  45 (defun write-u32 (integer &optional (stream *standard-output*))
  46   (assert (<= 0 integer (expt 2 32)))
  47   (write-variable-length-encoded integer stream))
  48
  49 (defun write-s32 (integer &optional (stream *standard-output*))
  50   ;; flash 9/mxmlc seems to want negative #s stored as if they were
  51   ;; casted to uints first :/
  52
  53   (assert (<= (abs integer) (expt 2 32)))
  54   (when (< integer 0) (setf integer (+ (expt 2 32) integer)))
  55   (write-variable-length-encoded integer stream))
  56
  57 (defun write-double (float &optional (stream *standard-output*))
  58   (loop with d = (ieee-floats::encode-float64 float)
  59      for i from 0 below 64 by 8
  60      do (write-byte (ldb (byte 8 i) d) stream)))
  61
  62 (defun write-counted-sequence (function seq &key (count-adjust 0) (start 0))
  63   (declare (ignorable start))
  64   ;;(format *error-output* "counted seq ~d (+ ~d ) entries ~a ~%" (length seq) count-adjust function)
  65   (if (<= (length seq) start)
  66       (write-u30 0)
  67       (progn
  68         (write-u30 (+ (length seq) count-adjust))
  69         (loop for i from start below (length seq)
  70            do (funcall function (elt seq i))))))
  71
  72 (defun write-string-info (string &optional (stream *standard-output*))
  73   (let ((utf8 (sb-ext:string-to-octets string :external-format :utf-8)))
  74     (write-u30 (length utf8))
  75     (write-sequence utf8 stream)))
  76
  77 (defun write-0-terminated-string (string &optional (stream *standard-output*))
  78   (let ((utf8 (sb-ext:string-to-octets string :external-format :utf-8)))
  79     (write-sequence utf8 stream)
  80     (write-u8 0 stream)))
  81
  82 ;;;;;;;;;;;;;;;;;;;;;
  83 ;;; writers for asm level data structures
  84
  85 (defgeneric write-generic (data &optional *standard-output*))
  86
  87 (defmethod write-generic ((trait avm2-asm::trait-info) &optional (*standard-output* *standard-output*))
  88   #+nil(format *trace-output* "trait-data : ~s ~s~%"
  89           (avm2-asm::name trait)
  90            (avm2-asm::trait-data trait))
  91   (write-u30 (avm2-asm::name trait))
  92   (write-generic (avm2-asm::trait-data trait))
  93   (when (not (zerop (logand #x40 (avm2-asm::kind (avm2-asm::trait-data trait)))))
  94     (write-counted-sequence 'write-u30 (avm2-asm::metadata trait))))
  95
  96 (defmethod write-generic ((td avm2-asm::trait-data-slot/const) &optional (*standard-output* *standard-output*))
  97   #+nil(format *trace-output* "trait-data-slot/const :~s ~s ~s ~s ~s~%"
  98           (avm2-asm::kind td)
  99           ( avm2-asm::slot-id td)
 100           ( avm2-asm::type-name td)
 101           (avm2-asm::vindex td)
 102           (avm2-asm::vkind td))
 103   (write-u8 (avm2-asm::kind td))
 104   (write-u30 (avm2-asm::slot-id td))
 105   (write-u30 (avm2-asm::type-name td))
 106   (write-u30 (avm2-asm::vindex td))
 107   (unless (zerop (avm2-asm::vindex td))
 108     (write-u8 (avm2-asm::vkind td))))
 109
 110 (defmethod write-generic ((td avm2-asm::trait-data-class) &optional (*standard-output* *standard-output*))
 111   (write-u8 (avm2-asm::kind td))
 112   (write-u30 (avm2-asm::slot-id td))
 113   (write-u30 (avm2-asm::classi td)))
 114
 115 (defmethod write-generic ((td avm2-asm::trait-data-function) &optional (*standard-output* *standard-output*))
 116   (write-u8 (avm2-asm::kind td))
 117   (write-u30 (avm2-asm::slot-id td))
 118   (write-u30 (avm2-asm::fn td)))
 119
 120 (defmethod write-generic ((td avm2-asm::trait-data-method/get/set) &optional (*standard-output* *standard-output*))
 121   (write-u8 (avm2-asm::kind td))
 122   (write-u30 (avm2-asm::slot-id td))
 123   (write-u30 (avm2-asm::method-id td)))
 124
 125
 126 (defun write-namespace (namespace &optional (stream *standard-output*))
 127   "storing namespace_info as (kind name_index) for now "
 128   (write-u8 (first namespace) stream)
 129   (write-u30 (second namespace) stream))
 130
 131 (defun write-namespace-set (namespace-set &optional (stream *standard-output*))
 132   "namespace-set (ns_set_info) = (ns1 ns2 ... nsN)"
 133   (write-u30 (length namespace-set) stream)
 134   (loop for i in namespace-set
 135      do (write-u30 i stream)))
 136
 137 (defun write-multiname (multiname &optional (stream *standard-output*))
 138   "multiname_info = (kind values*) for now, 0-2 values depending on kind"
 139   ;;; TODO: error checking
 140   (let ((kind (first multiname)))
 141     (write-u8 kind stream)
 142     (loop for i in (cdr multiname)
 143        do (write-u30 i stream))))
 144
 145
 146 (defun write-method-info (method-info &optional (*standard-output* *standard-output*))
 147   "u30 param-count, u30 return-type, u30 param-type[param-count], u30 name,
 148  u8 flags, option_info, param-info ==
 149   (name (param types = multinames) return-type flags (option) (param names)"
 150   (destructuring-bind (name param-types return-type flags &optional optional-params pnames)
 151       method-info
 152     (write-u30 (length param-types))
 153     (write-u30 return-type)
 154     (map 'nil 'write-u30 param-types)
 155     (write-u30 name)
 156     (write-u8 flags)
 157     (when optional-params
 158       (write-u30 (length optional-params))
 159       ;; optional-param = (( val . kind )
 160       (map 'nil (lambda (a)
 161                   (write-u30 (car a))
 162                   (write-u8 (cdr a))) optional-params))
 163     (when pnames
 164       (write-u30 (length pnames))
 165       (map 'nil 'write-u30 pnames))))
 166
 167 (defun write-metadata-info (metadata &optional (*standard-output* *standard-output*))
 168   "metadata = (name (item_info ... )), item_info = (key . value)"
 169   (write-u30 (car metadata))
 170   (write-u30 (length (second metadata)))
 171   (map 'nil (lambda (a) (write-u30 (car a))  (write-u30 (cdr a)))
 172        (second metadata)))
 173
 174 (defun write-instance (instance &optional (*standard-output* *standard-output*))
 175   (destructuring-bind
 176         (name super-name flags interfaces iinit traits
 177               &optional protected-ns) instance
 178     #+nil(format *trace-output* "write instance ~s~%  ~s ~s ~s ~s ~s ~s ~s~% ~s~%"
 179             instance
 180             name super-name flags interfaces iinit traits protected-ns
 181             (assoc iinit (function-names *compiler-context*) :test 'equal))
 182     (write-u30 name)
 183     (write-u30 super-name)
 184     (write-u8 flags)
 185     (when (not (zerop (logand flags avm2-asm::+class-protected-ns+)))
 186       (write-u30 protected-ns))
 187     (write-counted-sequence 'write-u30 interfaces)
 188     (write-u30 iinit)
 189     (write-counted-sequence 'write-generic traits)))
 190
 191 (defun write-class (class &optional (*standard-output* *standard-output*))
 192   " class = (cinit trait1 trait2 ... traitN)"
 193   #+nil(format *trace-output* "write class ~s~%  ~s~%  ~S~%"
 194           class
 195           (assoc (car class) (function-names *compiler-context*) :test 'equal)
 196           (cdr class))
 197   (write-u30 (car class))
 198   (write-counted-sequence 'write-generic (cdr class)))
 199
 200
 201
 202 (defun write-script (script &optional (*standard-output* *standard-output*))
 203   " script = (init trait1 trait2 ... traitN)"
 204   (write-u30 (car script))
 205   (write-counted-sequence 'write-generic (cdr script)))
 206
 207 (defun write-method-body (method-body &optional (*standard-output* *standard-output*))
 208   (write-u30 (avm2-asm::method-id method-body))
 209   (write-u30 (avm2-asm::max-stack method-body))
 210   (write-u30 (1+ (avm2-asm::local-count method-body)))
 211   (write-u30 (avm2-asm::init-scope-depth method-body))
 212   (write-u30 (avm2-asm::max-scope-depth method-body))
 213   (write-counted-sequence 'write-u8 (avm2-asm::code method-body))
 214   (write-counted-sequence 'write-generic (avm2-asm::exceptions method-body))
 215   (write-counted-sequence 'write-generic (avm2-asm::traits method-body)))
 216
 217 (defmethod write-generic ((ei avm2-asm::exception-info) &optional (*standard-output* *standard-output*))
 218   (write-u30 (avm2-asm::from ei))
 219   (write-u30 (avm2-asm::to ei))
 220   (write-u30 (avm2-asm::target ei))
 221   (write-u30 (avm2-asm::exc-type ei))
 222   (write-u30 (avm2-asm::var-name ei)))
 223
 224
 225
 226 (defun write-abc-file (&optional (data avm2-asm::*assembler-context*) (*standard-output* *standard-output*))
 227   (with-accessors
 228         ((ints avm2-asm::ints) (uints avm2-asm::uints) (doubles avm2-asm::doubles)
 229          (strings avm2-asm::strings) (namespaces avm2-asm::namespaces)
 230          (ns-sets avm2-asm::ns-sets) (multinames avm2-asm::multinames)
 231          (method-infos avm2-asm::method-infos) (metadata avm2-asm::metadata)
 232          (classes avm2-asm::classes) (instances avm2-asm::instances)
 233          (scripts avm2-asm::scripts) (method-bodies avm2-asm::method-bodies))
 234       data
 235
 236     (write-u16 16) ;minor version
 237     (write-u16 46) ;major version
 238     ;; constant pool
 239     (write-counted-sequence 'write-s32 ints :start 1)
 240     (write-counted-sequence 'write-u32 uints :start 1)
 241     (write-counted-sequence 'write-double doubles :start 1)
 242     (write-counted-sequence 'write-string-info strings :start 1)
 243     (write-counted-sequence 'write-namespace namespaces :start 1)
 244     (write-counted-sequence 'write-namespace-set ns-sets :start 1)
 245     (write-counted-sequence 'write-multiname multinames :start 1)
 246     ;; methods, etc
 247     (write-counted-sequence 'write-method-info method-infos)
 248     (write-counted-sequence 'write-metadata-info metadata)
 249     (write-counted-sequence 'write-instance instances)
 250     ;; classes and instances share the same length field
 251     (map 'nil 'write-class classes)
 252     (write-counted-sequence 'write-script scripts)
 253     (write-counted-sequence 'write-method-body method-bodies)))
 254
 255 (defun write-as3-tag (as3 tag-name &optional (*standard-output* *standard-output*))
 256   ;; always use the long form for size for now...
 257   (let ((size-pos (file-position *standard-output*)) start)
 258     ;; (write-u16 (logior (ash #x48 6) 63)) ;; was #x48, (x52?)
 259     ;; tag DoABC = 82
 260     (write-u16 (logior (ash #x52 6) 63))
 261     (setf size-pos (file-position *standard-output*))
 262     (write-u32-raw 0)    ;; size, to be filled in later
 263     (setf start (file-position *standard-output*))
 264     ;; flags 1 = lazy initialize
 265     (write-sequence '(01 00 00 00) *standard-output*)
 266     ;; tag name
 267     (write-0-terminated-string tag-name *standard-output*)
 268     ;; write the abc data
 269     (write-abc-file as3)
 270     ;; fill in the tag size
 271     (let* ((here (file-position *standard-output*))
 272            (length (- here start)))
 273       (file-position *standard-output* size-pos)
 274       (write-u32-raw (+ length  ))
 275       (file-position *standard-output* here))))
 276
 277 (defmacro write-tag ((tag stream) &body body)
 278   ;; fixme: handle short tags more efficiently
 279   (let ((start (gensym))
 280         (end (gensym)))
 281     `(let ((,start (file-position ,stream)))
 282        (write-u16 (logior (ash ,tag 6) 63) ,stream)
 283        (setf ,start (file-position ,stream))
 284        (write-u32-raw 0 ,stream)    ;; size, to be filled in later
 285        ,@body
 286     ;; fill in the tag size
 287     (let* ((,end (file-position ,stream)))
 288       (file-position ,stream ,start)
 289       (write-u32-raw  (- ,end ,start 4) ,stream)
 290       (file-position ,stream ,end)))))
 291
 292
 293 (defun write-swf (stream frame-label symbol-classes)
 294   ;;; write out a minimal .swf, based on the stuff hxasm writes
 295   (write-sequence '(#x46 #x57 #x53 #x09) stream) ;;magic "FWS9"
 296   ;;  (write-u32-raw (+ #x17 6 (length as3) (if (>= (length as3) 63) 6 2)) stream)
 297   ;; file length (filled in later)
 298   (write-u32-raw 0 stream)
 299   ;; 8000x6000 twips = 400x300 pels
 300   (write-sequence '(#x78 #x00 #x03 #xe8 #x00 #x00 #x0b #xb8 #x00) stream)
 301   (write-u16 #x1e00 stream) ;; 30fps
 302   (write-u16 #x0001 stream) ;; 1 frame
 303
 304   ;; FileAttributes tag
 305   (write-u16 (logior (ash #x45 6) 4) stream) ;; type=69 + length=4
 306   (write-u8 #b00011001 stream) ;; flags: reserved=000, HasMetadata=1,AS3=1,res=00, UseNetwork=1
 307   (write-u8 0 stream) ;;reserved
 308   (write-u8 0 stream) ;;reserved
 309   (write-u8 0 stream) ;;reserved
 310
 311   ;; Script Limits tag type=65, length = 4
 312   (write-sequence '(#x44 #x10 #xe8 #x03 #x3c #x00) stream) ;; script limits? stack 1000, time 60
 313
 314   ;; SetBackgroundColor tag type=9, length=3 color=#x869ca7
 315   (write-sequence '(#x43 #x02      #x86 #x9c #xa7 ) stream) ;; bg color?
 316   ;; FrameLabel tag type=43, length=4
 317   ;; (write-sequence '(#xc4 #x0a #x66 #x6f #x6f 00) stream) ;; frame label
 318   (write-tag (43 stream)
 319     (write-0-terminated-string frame-label stream))
 320
 321   ;; AS3 tag
 322   (write-as3-tag avm2-asm::*assembler-context* "frame" stream)
 323   ;; SymbolClass tag, tag=76 length=8
 324   ;;(write-u16 #x1308 stream) ;;tag+length
 325   ;;   NumSymbols=#x0001 Tag[1] = #x0000 Name[1]="foo"#x0
 326   ;;  (write-sequence '(#x01 00 00 00 #x66 #x6f #x6f 00) stream)
 327   (write-tag (76 stream)
 328     (write-u16 (length symbol-classes) stream) ;; # of symbols
 329     (loop for i in symbol-classes
 330          do
 331          (write-u16 (first i) stream) ;; tag
 332          (write-0-terminated-string (second i) stream))) ;; name
 333
 334   ;; ShowFrame tag type=1, length=0
 335   (write-u16 (logior (ash #x01 6) 0) stream) ;; show frame tag
 336   ;; End tag type=1, length=0
 337   (write-u16 (logior (ash #x00 6) 0) stream) ;; end tag
 338   ;; fill in the file size
 339   (file-position stream 4)
 340   (write-u32-raw (file-length stream) stream)
 341 )
 342
 343
 344 ;;; fixme: deal with package stuff, possibly reorganize stuff between asm/compiler...
 345
 346 (defun super-names (name)
 347   (let ((s (assoc name *flash-player-classes* :test 'string=)))
 348     (if s
 349         (cons (second s) (super-names (second s)))
 350         s)))
 351
 352 (defun push-lex-scope (mn-index)
 353   `((:get-lex ,(if (integerp mn-index) `(:id ,mn-index)mn-index))
 354     (:push-scope)))
 355
 356 (defun new-class+scopes (class-id)
 357   ;; fixme: allow class lookup instead of using class-id directly?
 358   #+nil(format t "cid = ~a classes=~s~%" class-id (avm2-asm::classes avm2-asm::*assembler-context*))
 359   #+nil(format t " instances = ~s~%" (avm2-asm::instances avm2-asm::*assembler-context*))
 360   (let* ((class (aref (avm2-asm::classes avm2-asm::*assembler-context*) class-id))
 361          (inst (aref (avm2-asm::instances avm2-asm::*assembler-context*) class-id)))
 362     (declare (ignorable class))
 363     (destructuring-bind (name-mn super-mn flags interfaces instance-init traits protected-ns)
 364         inst
 365       (declare (ignorable name-mn super-mn flags interfaces instance-init traits protected-ns))
 366       #+nil(format t "cid = ~a name-mn = ~a=~a  super-mn = ~a=~a ~%"
 367               class-id name-mn (avm2-asm::qname-string name-mn)
 368               super-mn (avm2-asm::qname-string super-mn))
 369       ;;(format t " supers = ~s~%" (reverse (super-names (avm2-asm::qname-string super-mn))))
 370       (let ((supers (reverse (super-names (avm2-asm::qname-string super-mn)))))
 371         `((:get-scope-object 0)
 372           ,@(loop for i in supers
 373                append (push-lex-scope i))
 374           ,@(push-lex-scope super-mn)
 375           (:get-lex (:id ,super-mn))
 376           (:new-class ,class-id)
 377           ,@(loop repeat (1+ (length supers))
 378                collect `(:pop-scope))
 379           (:init-property (:id ,name-mn)))))))
 380
 381
 382 (defun assemble-function (name)
 383   #+nil(format t "--assemble-function ~s :~%" name)
 384   (destructuring-bind (n nid argtypes return-type flags asm)
 385       (find-swf-function name)
 386     (let ((mid (avm2-asm::avm2-method nid argtypes return-type flags
 387                                     :body (avm2-asm::assemble-method-body asm))))
 388       (push (list n mid) (function-names *compiler-context*)))))
 389
 390 (defun assemble-class (name ns super properties constructor)
 391   (let* ((constructor-mid (avm2-asm::avm2-method
 392                            0 ;; name
 393                            (loop for i in (first constructor)
 394                               collect 0) ;; constructor arg types
 395                            0 0
 396                            :body
 397                            (avm2-asm::assemble-method-body
 398                             (%compile-defun (first constructor)
 399                                             (second constructor) t t))))
 400          ;; fixme: probably should make this configurable at some point
 401          (class-init (avm2-asm::avm2-method 0 nil 0 0 ;; meta-class init
 402                                           :body
 403                                           (avm2-asm::assemble-method-body
 404                                            `((:get-local-0)
 405                                              (:push-scope)
 406                                              (:return-void))
 407                                            :init-scope 0)))
 408          (junk (avm2-asm::avm2-ns-intern ns))
 409          (class (avm2-asm::avm2-class
 410                  (avm2-asm::asm-intern-multiname name)
 411                  (avm2-asm::asm-intern-multiname
 412                   (or (car (find-swf-class super))
 413                       super))
 414                  ;; todo: add interfaces
 415                  09 nil ;; flags, interfaces
 416                  constructor-mid
 417                  (loop for i in properties
 418                     collect
 419                       (make-instance
 420                        'avm2-asm::trait-info
 421                        'avm2-asm::name (avm2-asm::asm-intern-multiname i)
 422                        'avm2-asm::trait-data
 423                        (make-instance 'avm2-asm::trait-data-slot/const
 424                                                     'avm2-asm::kind 0
 425                                                     'avm2-asm::slot-id 0 ;; auto-assign
 426                                                     'avm2-asm::type-name 0 ;; */t
 427                                                     'avm2-asm::vindex 0 ;; no value
 428                                                     'avm2-asm::vkind 0 ;; no value
 429                                                     )))
 430                  class-init
 431                  :protected-ns junk
 432                  ;; todo: class traits
 433                  ;; :class-traits nil
 434                  )))
 435     (push (list name class) (class-names *compiler-context*))))
 436
 437 (defparameter *break-compile* nil)
 438 ;;(setf *break-compile* t)
 439 ;;; quick hack for testing, need to write a proper API at some point, which
 440 ;;;  compiles functions from a list of packages or whatever
 441 (defmacro with-compilation-to-stream (s (frame-name exports) &body body)
 442   (let ((script-init (gensym))
 443         (i (gensym)))
 444
 445     `(let ((avm2-asm::*assembler-context* (make-instance 'avm2-asm::assembler-context))
 446            (*compiler-context* (make-instance 'compiler-context))
 447            (*symbol-table* (make-instance 'symbol-table :inherit (list *cl-symbol-table*))))
 448        ;; fixme: add these to assembler-context constructor or something
 449        (avm2-asm::avm2-intern "")
 450        (avm2-asm::avm2-ns-intern "")
 451        #+nil(format t "==-== body~%")
 452        ;; compile the body code
 453        ,@body
 454        #+nil(format t "==-== classes~%")
 455        ;; assemble classes
 456        (loop for k being the hash-keys of (classes *cl-symbol-table*)
 457           using (hash-value v)
 458           for (swf-name ns super properties constructor) = v
 459           when (or properties constructor)
 460           do (assemble-class swf-name ns super properties constructor))
 461        (loop for k being the hash-keys of (classes *symbol-table*)
 462           using (hash-value v)
 463           for (swf-name ns super properties constructor) = v
 464           when (or properties constructor)
 465           do (assemble-class swf-name ns super properties constructor))
 466        #+nil(format t "==-== functions~%")
 467        ;; assemble functions
 468        (loop for k being the hash-keys of (functions *cl-symbol-table*)
 469           do (assemble-function k))
 470        (loop for k being the hash-keys of (functions *symbol-table*)
 471           do (assemble-function k))
 472        #+nil(format t "==-== boilerplate~%")
 473        ;; script boilerplate
 474        (let ((,script-init
 475               (avm2-asm::avm2-method
 476                0 () 0 0
 477                :body
 478                (avm2-asm::assemble-method-body
 479                 `((:get-local-0)
 480                   (:push-scope)
 481                   ,@(loop for ,i below (length (avm2-asm::classes avm2-asm::*assembler-context*))
 482                        append (new-class+scopes ,i))
 483                   (:return-void))))))
 484          #+nil(format t "==-== boilerplate2~%")
 485          (vector-push-extend
 486           `(,,script-init
 487             ,@(loop for i in (class-names *compiler-context*)
 488                  ;;do (format t "-=c-~s~%" i)
 489                  collect (make-instance 'avm2-asm::trait-info
 490                                         'avm2-asm::name
 491                                         (avm2-asm::asm-intern-multiname (first i))
 492                                         'avm2-asm::trait-data
 493                                         (make-instance 'avm2-asm::trait-data-class
 494                                                        'avm2-asm::slot-id 0
 495                                                        'avm2-asm::classi (second i))))
 496             ,@(loop for i in (function-names *compiler-context*)
 497                  ;;do (format t "-=f-~s~%" i)
 498                  collect (make-instance 'avm2-asm::trait-info
 499                                         'avm2-asm::name
 500                                         (if (numberp (first i))
 501                                             (first i)
 502                                             (avm2-asm::asm-intern-multiname (first i)))
 503                                         'avm2-asm::trait-data (make-instance 'avm2-asm::trait-data-method/get/set
 504                                                                             'avm2-asm::slot-id 0
 505                                                                             'avm2-asm::method (second i)))))
 506           (avm2-asm::scripts avm2-asm::*assembler-context*)))
 507
 508        (when *break-compile* (break))
 509        #+nil(format t "==-== write~%")
 510        ;; write out the .swf
 511        (write-swf ,s ,frame-name ,exports))))