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>
This commit is contained in:
ManDude
2023-10-30 03:20:02 +00:00
committed by GitHub
parent 09536c68ac
commit cd68cb671e
2079 changed files with 94384 additions and 117066 deletions
+122 -167
View File
@@ -3,27 +3,24 @@
;; definition of type kernel-context
(deftype kernel-context (basic)
((prevent-from-run process-mask :offset-assert 4)
(require-for-run process-mask :offset-assert 8)
(allow-to-run process-mask :offset-assert 12)
(next-pid int32 :offset-assert 16)
(fast-stack-top pointer :offset-assert 20)
(current-process process :offset-assert 24)
(relocating-process basic :offset-assert 28)
(relocating-min int32 :offset-assert 32)
(relocating-max int32 :offset-assert 36)
(relocating-offset int32 :offset-assert 40)
(relocating-level level :offset-assert 44)
(low-memory-message symbol :offset-assert 48)
(login-object basic :offset-assert 52)
((prevent-from-run process-mask)
(require-for-run process-mask)
(allow-to-run process-mask)
(next-pid int32)
(fast-stack-top pointer)
(current-process process)
(relocating-process basic)
(relocating-min int32)
(relocating-max int32)
(relocating-offset int32)
(relocating-level level)
(low-memory-message symbol)
(login-object basic)
)
:method-count-assert 9
:size-assert #x38
:flag-assert #x900000038
)
;; definition for method 3 of type kernel-context
(defmethod inspect kernel-context ((this kernel-context))
(defmethod inspect ((this kernel-context))
(when (not this)
(set! this this)
(goto cfg-4)
@@ -49,43 +46,37 @@
;; definition of type time-frame
(deftype time-frame (int64)
()
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
;; definition of type clock
(deftype clock (basic)
((index int32 :offset-assert 4)
(mask process-mask :offset-assert 8)
(clock-ratio float :offset-assert 12)
(accum float :offset-assert 16)
(integral-accum float :offset-assert 20)
(frame-counter time-frame :offset-assert 24)
(old-frame-counter time-frame :offset-assert 32)
(integral-frame-counter uint64 :offset-assert 40)
(old-integral-frame-counter uint64 :offset-assert 48)
(sparticle-data vector :inline :offset-assert 64)
(seconds-per-frame float :offset-assert 80)
(frames-per-second float :offset-assert 84)
(time-adjust-ratio float :offset-assert 88)
((index int32)
(mask process-mask)
(clock-ratio float)
(accum float)
(integral-accum float)
(frame-counter time-frame)
(old-frame-counter time-frame)
(integral-frame-counter uint64)
(old-integral-frame-counter uint64)
(sparticle-data vector :inline)
(seconds-per-frame float)
(frames-per-second float)
(time-adjust-ratio float)
)
:method-count-assert 15
:size-assert #x5c
:flag-assert #xf0000005c
(:methods
(new (symbol type int) _type_ 0)
(update-rates! (_type_ float) float 9)
(advance-by! (_type_ float) clock 10)
(tick! (_type_) clock 11)
(save! (_type_ (pointer uint64)) int 12)
(load! (_type_ (pointer uint64)) int 13)
(reset! (_type_) none 14)
(new (symbol type int) _type_)
(update-rates! (_type_ float) float)
(advance-by! (_type_ float) clock)
(tick! (_type_) clock)
(save! (_type_ (pointer uint64)) int)
(load! (_type_ (pointer uint64)) int)
(reset! (_type_) none)
)
)
;; definition for method 3 of type clock
(defmethod inspect clock ((this clock))
(defmethod inspect ((this clock))
(when (not this)
(set! this this)
(goto cfg-4)
@@ -123,28 +114,25 @@
;; definition of type thread
(deftype thread (basic)
((name symbol :offset-assert 4)
(process process :offset-assert 8)
(previous thread :offset-assert 12)
(suspend-hook (function cpu-thread none) :offset-assert 16)
(resume-hook (function cpu-thread none) :offset-assert 20)
(pc pointer :offset-assert 24)
(sp pointer :offset-assert 28)
(stack-top pointer :offset-assert 32)
(stack-size int32 :offset-assert 36)
((name symbol)
(process process)
(previous thread)
(suspend-hook (function cpu-thread none))
(resume-hook (function cpu-thread none))
(pc pointer)
(sp pointer)
(stack-top pointer)
(stack-size int32)
)
:method-count-assert 12
:size-assert #x28
:flag-assert #xc00000028
(:methods
(stack-size-set! (_type_ int) none 9)
(thread-suspend (_type_) none 10)
(thread-resume (_type_) none 11)
(stack-size-set! (_type_ int) none)
(thread-suspend (_type_) none)
(thread-resume (_type_) none)
)
)
;; definition for method 3 of type thread
(defmethod inspect thread ((this thread))
(defmethod inspect ((this thread))
(when (not this)
(set! this this)
(goto cfg-4)
@@ -165,20 +153,17 @@
;; definition of type cpu-thread
(deftype cpu-thread (thread)
((rreg uint64 7 :offset-assert 40)
(freg float 8 :offset-assert 96)
(stack uint8 :dynamic :offset-assert 128)
((rreg uint64 7)
(freg float 8)
(stack uint8 :dynamic)
)
:method-count-assert 12
:size-assert #x80
:flag-assert #xc00000080
(:methods
(new (symbol type process symbol int pointer) _type_ 0)
(new (symbol type process symbol int pointer) _type_)
)
)
;; definition for method 3 of type cpu-thread
(defmethod inspect cpu-thread ((this cpu-thread))
(defmethod inspect ((this cpu-thread))
(when (not this)
(set! this this)
(goto cfg-4)
@@ -203,18 +188,15 @@
;; definition of type dead-pool
(deftype dead-pool (process-tree)
()
:method-count-assert 16
:size-assert #x24
:flag-assert #x1000000024
(:methods
(new (symbol type int int string) _type_ 0)
(get-process (_type_ type int) process 14)
(return-process (_type_ process) none 15)
(new (symbol type int int string) _type_)
(get-process (_type_ type int) process)
(return-process (_type_ process) none)
)
)
;; definition for method 3 of type dead-pool
(defmethod inspect dead-pool ((this dead-pool))
(defmethod inspect ((this dead-pool))
(when (not this)
(set! this this)
(goto cfg-68)
@@ -333,18 +315,15 @@
;; definition of type dead-pool-heap-rec
(deftype dead-pool-heap-rec (structure)
((process process :offset-assert 0)
(prev dead-pool-heap-rec :offset-assert 4)
(next dead-pool-heap-rec :offset-assert 8)
((process process)
(prev dead-pool-heap-rec)
(next dead-pool-heap-rec)
)
:pack-me
:method-count-assert 9
:size-assert #xc
:flag-assert #x90000000c
)
;; definition for method 3 of type dead-pool-heap-rec
(defmethod inspect dead-pool-heap-rec ((this dead-pool-heap-rec))
(defmethod inspect ((this dead-pool-heap-rec))
(when (not this)
(set! this this)
(goto cfg-4)
@@ -359,42 +338,39 @@
;; definition of type dead-pool-heap
(deftype dead-pool-heap (dead-pool)
((allocated-length int32 :offset-assert 36)
(compact-time uint32 :offset-assert 40)
(compact-count-targ uint32 :offset-assert 44)
(compact-count uint32 :offset-assert 48)
(fill-percent float :offset-assert 52)
(first-gap dead-pool-heap-rec :offset-assert 56)
(first-shrink dead-pool-heap-rec :offset-assert 60)
(heap kheap :inline :offset-assert 64)
(alive-list dead-pool-heap-rec :inline :offset-assert 80)
(last dead-pool-heap-rec :offset 84)
(dead-list dead-pool-heap-rec :inline :offset-assert 92)
(process-list dead-pool-heap-rec :inline :dynamic :offset-assert 104)
((allocated-length int32)
(compact-time uint32)
(compact-count-targ uint32)
(compact-count uint32)
(fill-percent float)
(first-gap dead-pool-heap-rec)
(first-shrink dead-pool-heap-rec)
(heap kheap :inline)
(alive-list dead-pool-heap-rec :inline)
(last dead-pool-heap-rec :overlay-at (-> alive-list prev))
(dead-list dead-pool-heap-rec :inline)
(process-list dead-pool-heap-rec :inline :dynamic)
)
:method-count-assert 28
:size-assert #x68
:flag-assert #x1c00000068
(:methods
(new (symbol type string int int) _type_ 0)
(init (_type_ symbol int) none 16)
(compact (dead-pool-heap int) none 17)
(shrink-heap (dead-pool-heap process) dead-pool-heap 18)
(churn (dead-pool-heap int) none 19)
(memory-used (_type_) int 20)
(memory-total (_type_) int 21)
(memory-free (dead-pool-heap) int 22)
(compact-time (dead-pool-heap) uint 23)
(gap-size (dead-pool-heap dead-pool-heap-rec) int 24)
(gap-location (dead-pool-heap dead-pool-heap-rec) pointer 25)
(find-gap (dead-pool-heap dead-pool-heap-rec) dead-pool-heap-rec 26)
(find-gap-by-size (dead-pool-heap int) dead-pool-heap-rec 27)
(new (symbol type string int int) _type_)
(init (_type_ symbol int) none)
(compact (dead-pool-heap int) none)
(shrink-heap (dead-pool-heap process) dead-pool-heap)
(churn (dead-pool-heap int) none)
(memory-used (_type_) int)
(memory-total (_type_) int)
(memory-free (dead-pool-heap) int)
(compact-time (dead-pool-heap) uint)
(gap-size (dead-pool-heap dead-pool-heap-rec) int)
(gap-location (dead-pool-heap dead-pool-heap-rec) pointer)
(find-gap (dead-pool-heap dead-pool-heap-rec) dead-pool-heap-rec)
(find-gap-by-size (dead-pool-heap int) dead-pool-heap-rec)
)
)
;; definition for method 3 of type dead-pool-heap
;; INFO: this function exists in multiple non-identical object files
(defmethod inspect dead-pool-heap ((this dead-pool-heap))
(defmethod inspect ((this dead-pool-heap))
(when (not this)
(set! this this)
(goto cfg-68)
@@ -525,21 +501,18 @@
;; definition of type catch-frame
(deftype catch-frame (stack-frame)
((sp int32 :offset-assert 12)
(ra int32 :offset-assert 16)
(freg float 10 :offset-assert 20)
(rreg uint128 7 :offset-assert 64)
((sp int32)
(ra int32)
(freg float 10)
(rreg uint128 7)
)
:method-count-assert 9
:size-assert #xb0
:flag-assert #x9000000b0
(:methods
(new (symbol type symbol function (pointer uint64)) object 0)
(new (symbol type symbol function (pointer uint64)) object)
)
)
;; definition for method 3 of type catch-frame
(defmethod inspect catch-frame ((this catch-frame))
(defmethod inspect ((this catch-frame))
(when (not this)
(set! this this)
(goto cfg-4)
@@ -557,18 +530,15 @@
;; definition of type protect-frame
(deftype protect-frame (stack-frame)
((exit (function object) :offset-assert 12)
((exit (function object))
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
(:methods
(new (symbol type (function object)) protect-frame 0)
(new (symbol type (function object)) protect-frame)
)
)
;; definition for method 3 of type protect-frame
(defmethod inspect protect-frame ((this protect-frame))
(defmethod inspect ((this protect-frame))
(when (not this)
(set! this this)
(goto cfg-4)
@@ -587,13 +557,10 @@
(pid int32 :offset 32 :size 32)
(u64 uint64 :offset 0 :size 64)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
;; definition for method 3 of type handle
(defmethod inspect handle ((this handle))
(defmethod inspect ((this handle))
(when (not this)
(set! this this)
(goto cfg-4)
@@ -606,7 +573,7 @@
)
;; definition for method 2 of type handle
(defmethod print handle ((this handle))
(defmethod print ((this handle))
(if (nonzero? this)
(format #t "#<handle :process ~A :pid ~D>" (handle->process this) (-> this pid))
(format #t "#<handle :process 0 :pid 0>")
@@ -616,22 +583,19 @@
;; definition of type state
(deftype state (protect-frame)
((code function :offset-assert 16)
(trans (function object) :offset-assert 20)
(post function :offset-assert 24)
(enter function :offset-assert 28)
(event (function process int symbol event-message-block object) :offset-assert 32)
((code function)
(trans (function object))
(post function)
(enter function)
(event (function process int symbol event-message-block object))
)
:method-count-assert 9
:size-assert #x24
:flag-assert #x900000024
(:methods
(new (symbol type symbol function (function object) function (function object) (function process int symbol event-message-block object)) _type_ 0)
(new (symbol type symbol function (function object) function (function object) (function process int symbol event-message-block object)) _type_)
)
)
;; definition for method 3 of type state
(defmethod inspect state ((this state))
(defmethod inspect ((this state))
(when (not this)
(set! this this)
(goto cfg-4)
@@ -651,21 +615,18 @@
;; definition of type event-message-block
(deftype event-message-block (structure)
((to-handle handle :offset-assert 0)
(to (pointer process) :offset 0)
(form-handle handle :offset-assert 8)
(from (pointer process) :offset 8)
(param uint64 6 :offset-assert 16)
(message symbol :offset-assert 64)
(num-params int32 :offset-assert 68)
((to-handle handle)
(to (pointer process) :overlay-at to-handle)
(form-handle handle)
(from (pointer process) :overlay-at form-handle)
(param uint64 6)
(message symbol)
(num-params int32)
)
:method-count-assert 9
:size-assert #x48
:flag-assert #x900000048
)
;; definition for method 3 of type event-message-block
(defmethod inspect event-message-block ((this event-message-block))
(defmethod inspect ((this event-message-block))
(when (not this)
(set! this this)
(goto cfg-8)
@@ -684,18 +645,15 @@
;; definition of type event-message-block-array
(deftype event-message-block-array (inline-array-class)
((data event-message-block :inline :dynamic :offset-assert 16)
((data event-message-block :inline :dynamic)
)
:method-count-assert 10
:size-assert #x10
:flag-assert #xa00000010
(:methods
(send-all! (_type_) none 9)
(send-all! (_type_) none)
)
)
;; definition for method 3 of type event-message-block-array
(defmethod inspect event-message-block-array ((this event-message-block-array))
(defmethod inspect ((this event-message-block-array))
(when (not this)
(set! this this)
(goto cfg-4)
@@ -713,16 +671,13 @@
;; definition of type sql-result
(deftype sql-result (basic)
((len int32 :offset-assert 4)
(allocated-length uint32 :offset-assert 8)
(error symbol :offset-assert 12)
(data string :dynamic :offset-assert 16)
((len int32)
(allocated-length uint32)
(error symbol)
(data string :dynamic)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
(:methods
(new (symbol type uint) _type_ 0)
(new (symbol type uint) _type_)
)
)
@@ -736,7 +691,7 @@
)
;; definition for method 2 of type sql-result
(defmethod print sql-result ((this sql-result))
(defmethod print ((this sql-result))
(format #t "#(~A" (-> this error))
(dotimes (s5-0 (-> this len))
(format #t " ~A" (-> this data s5-0))