unix.factor: Bug fix etc., boxing.factor: Improves record/unrecord-reps

master
kusumotonorio 2020-01-23 20:02:03 +09:00
parent 95519b0130
commit 1eaa895c8a
2 changed files with 10 additions and 14 deletions

View File

@ -12,18 +12,15 @@ SYMBOL: struct-return-area
SYMBOLS: int-reg-reps float-reg-reps ; SYMBOLS: int-reg-reps float-reg-reps ;
: record-reg-reps ( reps -- reps ) : reg-reps ( reps -- int-reps float-reps )
dup ! reps: { { reg-rep on-stack? odd-register? } ... } [ second ] reject [ [ first int-rep? ] count ] [ length over - ] bi ;
[ [ [ first int-rep? ] [ second not ] bi and ] count int-reg-reps +@ ]
[ [ [ first int-rep? not ] [ second not ] bi and ] count float-reg-reps +@ ] : record-reg-reps ( reps -- reps )
bi ; dup reg-reps [ int-reg-reps +@ ] [ float-reg-reps +@ ] bi* ;
: unrecord-reg-reps ( reps -- reps ) : unrecord-reg-reps ( reps -- reps )
dup dup reg-reps [ neg int-reg-reps +@ ] [ neg float-reg-reps +@ ] bi* ;
[ [ [ first int-rep? ] [ second not ] bi and ] count -1 * int-reg-reps +@ ]
[ [ [ first int-rep? not ] [ second not ] bi and ] count -1 * float-reg-reps +@ ]
bi ;
GENERIC: flatten-c-type ( c-type -- pairs ) GENERIC: flatten-c-type ( c-type -- pairs )
M: c-type flatten-c-type M: c-type flatten-c-type

View File

@ -31,8 +31,7 @@ M: x86.64 reserved-stack-space 0 ;
f f 3array f f 3array
] map :> reps ] map :> reps
int-reg-reps get float-reg-reps get and [ int-reg-reps get float-reg-reps get and [
reps [ first int-rep? ] count :> int-mems reps reg-reps :> ( int-mems float-mems )
reps length int-mems - :> float-mems
int-reg-reps get int-mems + 6 > int-reg-reps get int-mems + 6 >
float-reg-reps get float-mems + 8 > or [ float-reg-reps get float-mems + 8 > or [
reps [ first t f 3array ] map reps [ first t f 3array ] map
@ -42,8 +41,8 @@ M: x86.64 reserved-stack-space 0 ;
M: x86.64 flatten-struct-type ( c-type -- seq ) M: x86.64 flatten-struct-type ( c-type -- seq )
dup heap-size 16 <= dup heap-size 16 <=
[ flatten-small-struct record-reg-reps ] [ [ flatten-small-struct record-reg-reps ] [
call-next-method [ first t f 3array ] map call-next-method unrecord-reg-reps
unrecord-reg-reps [ first t f 3array ] map
] if ; ] if ;
M: x86.64 return-struct-in-registers? ( c-type -- ? ) M: x86.64 return-struct-in-registers? ( c-type -- ? )