Files
ManDude cd68cb671e deftype and defmethod syntax major changes (#3094)
Major change to how `deftype` shows up in our code:
- the decompiler will no longer emit the `offset-assert`,
`method-count-assert`, `size-assert` and `flag-assert` parameters. There
are extremely few cases where having this in the decompiled code is
helpful, as the types there come from `all-types` which already has
those parameters. This also doesn't break type consistency because:
  - the asserts aren't compared.
- the first step of the test uses `all-types`, which has the asserts,
which will throw an error if they're bad.
- the decompiler won't emit the `heap-base` parameter unless necessary
now.
- the decompiler will try its hardest to turn a fixed-offset field into
an `overlay-at` field. It falls back to the old offset if all else
fails.
- `overlay-at` now supports field "dereferencing" to specify the offset
that's within a field that's a structure, e.g.:
```lisp
(deftype foobar (structure)
  ((vec    vector  :inline)
   (flags  int32   :overlay-at (-> vec w))
   )
  )
```
in this structure, the offset of `flags` will be 12 because that is the
final offset of `vec`'s `w` field within this structure.
- **removed ID from all method declarations.** IDs are only ever
automatically assigned now. Fixes #3068.
- added an `:overlay` parameter to method declarations, in order to
declare a new method that goes on top of a previously-defined method.
Syntax is `:overlay <method-name>`. Please do not ever use this.
- added `state-methods` list parameter. This lets you quickly specify a
list of states to be put in the method table. Same syntax as the
`states` list parameter. The decompiler will try to put as many states
in this as it can without messing with the method ID order.

Also changes `defmethod` to make the first type definition (before the
arguments) optional. The type can now be inferred from the first
argument. Fixes #3093.

---------

Co-authored-by: Hat Kid <6624576+Hat-Kid@users.noreply.github.com>
2023-10-30 03:20:02 +00:00

219 lines
8.2 KiB
Common Lisp
Vendored
Generated

;;-*-Lisp-*-
(in-package goal)
;; definition of type load-dir
(deftype load-dir (basic)
((lev level)
(string-array (array string))
(data-array (array basic))
)
(:methods
(new (symbol type int level) _type_)
(load-to-heap-by-name (_type_ string symbol kheap int) art-group)
(set-loaded-art (_type_ art-group) art-group)
)
)
;; definition of type load-dir-art-group
(deftype load-dir-art-group (load-dir)
((art-group-array (array art-group) :overlay-at data-array)
)
(:methods
(new (symbol type int level) _type_)
)
)
;; definition for method 0 of type load-dir
(defmethod new load-dir ((allocation symbol) (type-to-make type) (length int) (unk level))
(let ((this (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(set! (-> this lev) unk)
(set! (-> this string-array)
(the-as (array string) ((method-of-type array new) allocation array string length))
)
(set! (-> this string-array length) 0)
(set! (-> this data-array) (the-as (array basic) ((method-of-type array new) allocation array basic length)))
(set! (-> this data-array length) 0)
this
)
)
;; definition for method 0 of type load-dir-art-group
;; INFO: Return type mismatch load-dir vs load-dir-art-group.
(defmethod new load-dir-art-group ((allocation symbol) (type-to-make type) (length int) (unk level))
(let ((this ((method-of-type load-dir new) allocation type-to-make length unk)))
(set! (-> this data-array content-type) art-group)
(the-as load-dir-art-group this)
)
)
;; definition of type external-art-buffer
(deftype external-art-buffer (basic)
((index int32)
(other external-art-buffer)
(status symbol)
(locked? symbol)
(frame-lock symbol)
(heap kheap :inline)
(pending-load-file string)
(pending-load-file-part int32)
(pending-load-file-owner handle)
(pending-load-file-priority float)
(load-file string)
(load-file-part int32)
(load-file-owner handle)
(load-file-priority float)
(buf pointer)
(len int32)
(art-group art-group)
)
(:methods
(new (symbol type int) _type_)
(set-pending-file (_type_ string int handle float) int)
(update (_type_) int)
(inactive? (_type_) symbol)
(file-status (_type_ string int) symbol)
(link-file (_type_ art-group) art-group)
(unlink-file (_type_ art-group) int)
(unlock! (_type_) symbol)
)
)
;; definition for method 3 of type external-art-buffer
(defmethod inspect ((this external-art-buffer))
(format #t "[~8x] ~A~%" this (-> this type))
(format #t "~Tindex: ~D~%" (-> this index))
(format #t "~Tother: ~A~%" (-> this other))
(format #t "~Tstatus: ~A~%" (-> this status))
(format #t "~Tlocked?: ~A~%" (-> this locked?))
(format #t "~Tframe-lock: ~A~%" (-> this frame-lock))
(format #t "~Theap: #<kheap @ #x~X>~%" (-> this heap))
(format #t "~Tpending-load-file: ~A~%" (-> this pending-load-file))
(format #t "~Tpending-load-file-part: ~D~%" (-> this pending-load-file-part))
(format #t "~Tpending-load-file-owner: ~D~%" (-> this pending-load-file-owner))
(format #t "~Tpending-load-file-priority: ~f~%" (-> this pending-load-file-priority))
(format #t "~Tload-file: ~A~%" (-> this load-file))
(format #t "~Tload-file-part: ~D~%" (-> this load-file-part))
(format #t "~Tload-file-owner: ~D~%" (-> this load-file-owner))
(format #t "~Tload-file-priority: ~f~%" (-> this load-file-priority))
(format #t "~Tbuf: #x~X~%" (-> this buf))
(format #t "~Tlen: ~D~%" (-> this len))
(format #t "~Tart-group: ~A~%" (-> this art-group))
this
)
;; definition for method 0 of type external-art-buffer
(defmethod new external-art-buffer ((allocation symbol) (type-to-make type) (idx int))
(let ((this (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(set! (-> this index) idx)
(set! (-> this load-file) #f)
(set! (-> this load-file-part) -1)
(set! (-> this load-file-owner) (the-as handle #f))
(set! (-> this load-file-priority) 100000000.0)
(set! (-> this pending-load-file) #f)
(set! (-> this pending-load-file-part) -1)
(set! (-> this pending-load-file-owner) (the-as handle #f))
(set! (-> this pending-load-file-priority) 100000000.0)
(set! (-> this art-group) #f)
(set! (-> this status) 'initialize)
(set! (-> this locked?) #f)
(set! (-> this other) #f)
this
)
)
;; definition of type spool-anim
(deftype spool-anim (basic)
((name string :offset 16)
(buf1 external-art-buffer :overlay-at name)
(index int32 :offset 20)
(buf2 external-art-buffer :overlay-at index)
(parts int32)
(priority float)
(owner handle)
(command-list pair)
)
:pack-me
)
;; definition for method 3 of type spool-anim
(defmethod inspect ((this spool-anim))
(format #t "[~8x] ~A~%" this (-> this type))
(format #t "~Tname: ~A~%" (-> this name))
(format #t "~Tindex: ~D~%" (-> this index))
(format #t "~Tparts: ~D~%" (-> this parts))
(format #t "~Tpriority: ~f~%" (-> this priority))
(format #t "~Towner: ~D~%" (-> this owner))
(format #t "~Tcommand-list: ~A~%" (-> this command-list))
this
)
;; definition of type external-art-control
(deftype external-art-control (basic)
((buffer external-art-buffer 2)
(rec spool-anim 3 :inline)
(spool-lock handle)
(reserve-buffer external-art-buffer)
(reserve-buffer-count int32)
(active-stream string)
(preload-stream spool-anim :inline)
(last-preload-stream spool-anim :inline)
(end-pad uint32)
)
(:methods
(new (symbol type) _type_)
(update (_type_ symbol) int)
(clear-rec (_type_) int)
(spool-push (_type_ string int process float) int)
(file-status (_type_ string int) symbol)
(reserve-alloc (_type_) kheap)
(reserve-free (_type_ kheap) int)
(none-reserved? (_type_) symbol)
(try-preload-stream (_type_ string int process float) int)
)
)
;; definition for method 3 of type external-art-control
(defmethod inspect ((this external-art-control))
(format #t "[~8x] ~A~%" this (-> this type))
(format #t "~Tbuffer[2] @ #x~X~%" (-> this buffer))
(format #t "~Trec[3] @ #x~X~%" (-> this rec))
(format #t "~Tspool-lock: ~D~%" (-> this spool-lock))
(format #t "~Treserve-buffer: ~A~%" (-> this reserve-buffer))
(format #t "~Treserve-buffer-count: ~D~%" (-> this reserve-buffer-count))
(format #t "~Tactive-stream: ~A~%" (-> this active-stream))
(format #t "~Tpreload-stream: #<spool-anim @ #x~X>~%" (-> this preload-stream))
(format #t "~Tlast-preload-stream: #<spool-anim @ #x~X>~%" (-> this last-preload-stream))
this
)
;; definition for method 0 of type external-art-control
(defmethod new external-art-control ((allocation symbol) (type-to-make type))
(let ((this (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(dotimes (buff-idx 2)
(set! (-> this buffer buff-idx)
((method-of-type external-art-buffer new) allocation external-art-buffer buff-idx)
)
)
(set! (-> this buffer 0 other) (-> this buffer 1))
(set! (-> this buffer 1 other) (-> this buffer 0))
(dotimes (rec-idx 3)
(set! (-> this rec rec-idx name) #f)
(set! (-> this rec rec-idx priority) 100000000.0)
(set! (-> this rec rec-idx owner) (the-as handle #f))
)
(set! (-> this spool-lock) (the-as handle #f))
(set! (-> this reserve-buffer) #f)
(set! (-> this active-stream) #f)
(set! (-> this preload-stream name) #f)
(set! (-> this preload-stream priority) 100000000.0)
(set! (-> this preload-stream owner) (the-as handle #f))
(set! (-> this last-preload-stream name) #f)
(set! (-> this last-preload-stream priority) 100000000.0)
(set! (-> this last-preload-stream owner) (the-as handle #f))
this
)
)
;; failed to figure out what this is:
0