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
+32 -33
View File
@@ -26,7 +26,7 @@
(define *last-loado-debug-usage* 0)
;; definition for method 7 of type object
(defmethod relocate object ((this object) (arg0 int))
(defmethod relocate ((this object) (arg0 int))
this
)
@@ -75,7 +75,7 @@
;; definition for method 1 of type thread
;; WARN: Return type mismatch int vs none.
(defmethod delete thread ((this thread))
(defmethod delete ((this thread))
(when (= this (-> this process main-thread))
(break!)
0
@@ -86,7 +86,7 @@
)
;; definition for method 2 of type thread
(defmethod print thread ((this thread))
(defmethod print ((this thread))
(format
#t
"#<~A ~S of ~S pc: #x~X @ #x~X>"
@@ -101,7 +101,7 @@
;; definition for method 9 of type thread
;; WARN: Return type mismatch int vs none.
(defmethod stack-size-set! thread ((this thread) (arg0 int))
(defmethod stack-size-set! ((this thread) (arg0 int))
(let ((a2-0 (-> this process)))
(cond
((!= this (-> a2-0 main-thread))
@@ -154,7 +154,7 @@
;; definition for method 5 of type cpu-thread
;; WARN: Return type mismatch uint vs int.
(defmethod asize-of cpu-thread ((this cpu-thread))
(defmethod asize-of ((this cpu-thread))
(the-as int (+ (-> this type size) (-> this stack-size)))
)
@@ -278,7 +278,7 @@
(define *pause-lock* #f)
;; definition for method 2 of type process-tree
(defmethod print process-tree ((this process-tree))
(defmethod print ((this process-tree))
(format #t "#<~A ~S @ #x~X>" (-> this type) (-> this name) this)
this
)
@@ -299,7 +299,7 @@
)
;; definition for method 3 of type process-tree
(defmethod inspect process-tree ((this process-tree))
(defmethod inspect ((this process-tree))
(format #t "[~8x] ~A~%" this (-> this type))
(format #t "~Tname: ~S~%" (-> this name))
(format #t "~1Tmask: #x~X : (process-mask " (-> this mask))
@@ -366,7 +366,7 @@
)
;; definition for method 3 of type process
(defmethod inspect process ((this process))
(defmethod inspect ((this process))
(format #t "[~8x] ~A~%" this (-> this type))
(format #t "~Tname: ~S~%" (-> this name))
(format #t "~1Tmask: #x~X : (process-mask " (-> this mask))
@@ -405,13 +405,12 @@
;; definition for method 5 of type process
;; WARN: Return type mismatch uint vs int.
(defmethod asize-of process ((this process))
(defmethod asize-of ((this process))
(the-as int (+ (-> process size) (-> this allocated-length)))
)
;; definition for method 2 of type process
;; INFO: this function exists in multiple non-identical object files
(defmethod print process ((this process))
(defmethod print ((this process))
(cond
((and (-> this top-thread) (!= (-> this status) 'dead))
(format #t "#<~A ~S ~A :state ~S " (-> this type) (-> this name) (-> this status) (if (-> this state)
@@ -485,7 +484,7 @@
)
;; definition for method 14 of type dead-pool
(defmethod get-process dead-pool ((this dead-pool) (arg0 type) (arg1 int))
(defmethod get-process ((this dead-pool) (arg0 type) (arg1 int))
(let ((s4-0 (the-as object (-> this child))))
(when (and (not (the-as (pointer process-tree) s4-0)) *debug-segment* (!= this *debug-dead-pool*))
(set! s4-0 (get-process *debug-dead-pool* arg0 arg1))
@@ -520,7 +519,7 @@
;; definition for method 15 of type dead-pool
;; WARN: Return type mismatch int vs none.
(defmethod return-process dead-pool ((this dead-pool) (arg0 process))
(defmethod return-process ((this dead-pool) (arg0 process))
(change-parent arg0 this)
0
(none)
@@ -544,7 +543,7 @@
;; definition for method 16 of type dead-pool-heap
;; WARN: Return type mismatch dead-pool-heap vs none.
(defmethod init dead-pool-heap ((this dead-pool-heap) (arg0 symbol) (arg1 int))
(defmethod init ((this dead-pool-heap) (arg0 symbol) (arg1 int))
(countdown (v1-0 (-> this allocated-length))
(let ((a0-4 (-> this process-list v1-0)))
(set! (-> a0-4 process) *null-process*)
@@ -579,7 +578,7 @@
;; definition for method 25 of type dead-pool-heap
;; WARN: Return type mismatch object vs pointer.
(defmethod gap-location dead-pool-heap ((this dead-pool-heap) (arg0 dead-pool-heap-rec))
(defmethod gap-location ((this dead-pool-heap) (arg0 dead-pool-heap-rec))
(the-as
pointer
(if (-> arg0 process)
@@ -590,7 +589,7 @@
)
;; definition for method 24 of type dead-pool-heap
(defmethod gap-size dead-pool-heap ((this dead-pool-heap) (arg0 dead-pool-heap-rec))
(defmethod gap-size ((this dead-pool-heap) (arg0 dead-pool-heap-rec))
(cond
((-> arg0 process)
(let ((v1-3 (&+ (&+ (the-as pointer (-> arg0 process)) (-> process size)) (-> arg0 process allocated-length))))
@@ -610,7 +609,7 @@
)
;; definition for method 26 of type dead-pool-heap
(defmethod find-gap dead-pool-heap ((this dead-pool-heap) (arg0 dead-pool-heap-rec))
(defmethod find-gap ((this dead-pool-heap) (arg0 dead-pool-heap-rec))
(while (and (-> arg0 next) (zero? (gap-size this arg0)))
(set! arg0 (-> arg0 next))
)
@@ -619,7 +618,7 @@
;; 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))
(format #t "[~8x] ~A~%" this (-> this type))
(format #t "~Tname: ~A~%" (-> this name))
(format #t "~1Tmask: #x~X : (process-mask " (-> this mask))
@@ -667,12 +666,12 @@
;; definition for method 5 of type dead-pool-heap
;; WARN: Return type mismatch uint vs int.
(defmethod asize-of dead-pool-heap ((this dead-pool-heap))
(defmethod asize-of ((this dead-pool-heap))
(the-as int (+ (-> this type size) (* 12 (-> this allocated-length))))
)
;; definition for method 20 of type dead-pool-heap
(defmethod memory-used dead-pool-heap ((this dead-pool-heap))
(defmethod memory-used ((this dead-pool-heap))
(if (-> this alive-list prev)
(- (memory-total this) (gap-size this (-> this alive-list prev)))
0
@@ -680,12 +679,12 @@
)
;; definition for method 21 of type dead-pool-heap
(defmethod memory-total dead-pool-heap ((this dead-pool-heap))
(defmethod memory-total ((this dead-pool-heap))
(&- (-> this heap top) (the-as uint (-> this heap base)))
)
;; definition for method 22 of type dead-pool-heap
(defmethod memory-free dead-pool-heap ((this dead-pool-heap))
(defmethod memory-free ((this dead-pool-heap))
(let ((v1-0 (-> this heap top)))
(if (-> this alive-list prev)
(gap-size this (-> this alive-list prev))
@@ -695,12 +694,12 @@
)
;; definition for method 23 of type dead-pool-heap
(defmethod compact-time dead-pool-heap ((this dead-pool-heap))
(defmethod compact-time ((this dead-pool-heap))
(-> this compact-time)
)
;; definition for method 27 of type dead-pool-heap
(defmethod find-gap-by-size dead-pool-heap ((this dead-pool-heap) (arg0 int))
(defmethod find-gap-by-size ((this dead-pool-heap) (arg0 int))
(let ((gp-0 (-> this first-gap)))
(while (and gp-0 (< (gap-size this gp-0) arg0))
(set! gp-0 (-> gp-0 next))
@@ -710,7 +709,7 @@
)
;; definition for method 14 of type dead-pool-heap
(defmethod get-process dead-pool-heap ((this dead-pool-heap) (arg0 type) (arg1 int))
(defmethod get-process ((this dead-pool-heap) (arg0 type) (arg1 int))
(let ((s4-0 (-> this dead-list next))
(s3-0 (the-as process #f))
)
@@ -770,7 +769,7 @@
;; definition for method 15 of type dead-pool-heap
;; WARN: Return type mismatch int vs none.
(defmethod return-process dead-pool-heap ((this dead-pool-heap) (arg0 process))
(defmethod return-process ((this dead-pool-heap) (arg0 process))
(if (!= this (-> arg0 pool))
(format 0 "ERROR: process ~A does not belong to dead-pool-heap ~A.~%" arg0 this)
)
@@ -803,7 +802,7 @@
)
;; definition for method 18 of type dead-pool-heap
(defmethod shrink-heap dead-pool-heap ((this dead-pool-heap) (arg0 process))
(defmethod shrink-heap ((this dead-pool-heap) (arg0 process))
(when arg0
(let ((s5-0 (-> arg0 ppointer)))
(when (not (or (logtest? (-> arg0 mask) (process-mask heap-shrunk))
@@ -828,7 +827,7 @@
;; definition for method 17 of type dead-pool-heap
;; WARN: Return type mismatch int vs none.
;; WARN: Function (method 17 dead-pool-heap) has a return type of none, but the expression builder found a return statement.
(defmethod compact dead-pool-heap ((this dead-pool-heap) (arg0 int))
(defmethod compact ((this dead-pool-heap) (arg0 int))
(if (zero? (-> this heap base))
(return 0)
)
@@ -889,7 +888,7 @@
;; definition for method 19 of type dead-pool-heap
;; WARN: Return type mismatch int vs none.
(defmethod churn dead-pool-heap ((this dead-pool-heap) (arg0 int))
(defmethod churn ((this dead-pool-heap) (arg0 int))
(while (nonzero? arg0)
(+! arg0 -1)
(let ((s4-0 (-> this alive-list next)))
@@ -1027,7 +1026,7 @@
)
;; definition for method 12 of type process
(defmethod run-logic? process ((this process))
(defmethod run-logic? ((this process))
#t
)
@@ -1399,7 +1398,7 @@
)
;; definition for method 9 of type process
(defmethod activate process ((this process) (arg0 process-tree) (arg1 basic) (arg2 pointer))
(defmethod activate ((this process) (arg0 process-tree) (arg1 basic) (arg2 pointer))
(set! (-> this mask) (logclear (-> arg0 mask) (process-mask sleep sleep-code process-tree heap-shrunk)))
(set! (-> this clock) (-> arg0 clock))
(set! (-> this status) 'ready)
@@ -1472,7 +1471,7 @@
;; definition for method 10 of type process-tree
;; WARN: Return type mismatch int vs none.
(defmethod deactivate process-tree ((this process-tree))
(defmethod deactivate ((this process-tree))
0
(none)
)
@@ -1489,7 +1488,7 @@
;; WARN: Return type mismatch int vs none.
;; ERROR: Unsupported inline assembly instruction kind - [lw ra, return-from-thread(s7)]
;; ERROR: Unsupported inline assembly instruction kind - [jr ra]
(defmethod deactivate process ((this process))
(defmethod deactivate ((this process))
(local-vars (s7-0 none) (ra-0 int))
(with-pp
(when (!= (-> this status) 'dead)