GENERIC: temp-vregs ( insn -- seq )
GENERIC: uses-vregs ( insn -- seq )
+M: insn defs-vreg drop f ;
+M: insn temp-vregs drop { } ;
+M: insn uses-vregs drop { } ;
+
M: ##phi uses-vregs inputs>> values ;
<PRIVATE
} case ;
: define-defs-vreg-method ( insn -- )
- [ \ defs-vreg create-method ]
- [ insn-def-slot [ name>> reader-word 1quotation ] [ [ drop f ] ] if* ] bi
- define ;
+ dup insn-def-slot dup [
+ [ \ defs-vreg create-method ]
+ [ name>> reader-word 1quotation ] bi*
+ define
+ ] [ 2drop ] if ;
: define-uses-vregs-method ( insn -- )
- [ \ uses-vregs create-method ]
- [ insn-use-slots [ name>> ] map slot-array-quot ] bi
- define ;
+ dup insn-use-slots [ drop ] [
+ [ \ uses-vregs create-method ]
+ [ [ name>> ] map slot-array-quot ] bi*
+ define
+ ] if-empty ;
: define-temp-vregs-method ( insn -- )
- [ \ temp-vregs create-method ]
- [ insn-temp-slots [ name>> ] map slot-array-quot ] bi
- define ;
+ dup insn-temp-slots [ drop ] [
+ [ \ temp-vregs create-method ]
+ [ [ name>> ] map slot-array-quot ] bi*
+ define
+ ] if-empty ;
PRIVATE>
{ byte-arrays:<byte-array> [ emit-<byte-array> ] }
{ byte-arrays:(byte-array) [ emit-(byte-array) ] }
{ kernel:<wrapper> [ emit-simple-allot ] }
- { alien:<displaced-alien> [ emit-<displaced-alien> ] }
+ ! { alien:<displaced-alien> [ emit-<displaced-alien> ] }
{ alien.accessors:alien-unsigned-1 [ 1 emit-alien-unsigned-getter ] }
{ alien.accessors:set-alien-unsigned-1 [ 1 emit-alien-integer-setter ] }
{ alien.accessors:alien-signed-1 [ 1 emit-alien-signed-getter ] }
GENERIC: rename-insn-defs ( insn -- )
-insn-classes get [
+M: insn rename-insn-defs drop ;
+
+insn-classes get [ insn-def-slot ] filter [
[ \ rename-insn-defs create-method-in ]
- [ insn-def-slot dup [ name>> 1array ] when DEF-QUOT slot-change-quot ] bi
+ [ insn-def-slot name>> 1array DEF-QUOT slot-change-quot ] bi
define
] each
GENERIC: rename-insn-uses ( insn -- )
-insn-classes get { ##phi } diff [
+M: insn rename-insn-uses drop ;
+
+insn-classes get { ##phi } diff [ insn-use-slots empty? not ] filter [
[ \ rename-insn-uses create-method-in ]
[ insn-use-slots [ name>> ] map USE-QUOT slot-change-quot ] bi
define
GENERIC: rename-insn-temps ( insn -- )
-insn-classes get [
+M: insn rename-insn-temps drop ;
+
+insn-classes get [ insn-temp-slots empty? not ] filter [
[ \ rename-insn-temps create-method-in ]
[ insn-temp-slots [ name>> ] map TEMP-QUOT slot-change-quot ] bi
define
GENERIC: temp-vreg-reps ( insn -- reps )
GENERIC: uses-vreg-reps ( insn -- reps )
+M: insn defs-vreg-rep drop f ;
+M: insn temp-vreg-reps drop { } ;
+M: insn uses-vreg-reps drop { } ;
+
<PRIVATE
: rep-getter-quot ( rep -- quot )
} case ;
: define-defs-vreg-rep-method ( insn -- )
- [ \ defs-vreg-rep create-method ]
- [ insn-def-slot [ rep>> rep-getter-quot ] [ [ drop f ] ] if* ]
- bi define ;
+ dup insn-def-slot dup [
+ [ \ defs-vreg-rep create-method ]
+ [ rep>> rep-getter-quot ]
+ bi* define
+ ] [ 2drop ] if ;
: reps-getter-quot ( reps -- quot )
dup [ rep>> { f scalar-rep } member-eq? not ] all? [
] if ;
: define-uses-vreg-reps-method ( insn -- )
- [ \ uses-vreg-reps create-method ]
- [ insn-use-slots reps-getter-quot ]
- bi define ;
+ dup insn-use-slots [ drop ] [
+ [ \ uses-vreg-reps create-method ]
+ [ reps-getter-quot ]
+ bi* define
+ ] if-empty ;
: define-temp-vreg-reps-method ( insn -- )
- [ \ temp-vreg-reps create-method ]
- [ insn-temp-slots reps-getter-quot ]
- bi define ;
+ dup insn-temp-slots [ drop ] [
+ [ \ temp-vreg-reps create-method ]
+ [ reps-getter-quot ]
+ bi* define
+ ] if-empty ;
PRIVATE>