suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix indirect unsigned return for arm32le

Browse Source 
original commit: 158ffeb1db8f425391193f2a205594e3f1a60e99
This commit is contained in:
Matthew Flatt 2020-06-06 08:53:14 -06:00
parent 237f0e4fa4
commit cb4c035a9e
3 changed files with 14 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
s/arm32.ss
View File

@ -3239,8 +3239,12 @@
[else [else
(values (lambda () (values (lambda ()
(case ($ftd-size ftd) (case ($ftd-size ftd)
[(1) `(set! ,%Cretval (inline ,(make-info-load 'integer-8 #f) ,%load ,%sp ,%zero (immediate ,return-stack-offset)))] [(1)
[(2) `(set! ,%Cretval (inline ,(make-info-load 'integer-16 #f) ,%load ,%sp ,%zero (immediate ,return-stack-offset)))] (let ([rep (if ($ftd-unsigned? ftd) 'unsigned-8 'integer-8)])
`(set! ,%Cretval (inline ,(make-info-load rep #f) ,%load ,%sp ,%zero (immediate ,return-stack-offset))))]
[(2)
(let ([rep (if ($ftd-unsigned? ftd) 'unsigned-16 'integer-16)])
`(set! ,%Cretval (inline ,(make-info-load rep #f) ,%load ,%sp ,%zero (immediate ,return-stack-offset))))]
[else `(set! ,%Cretval ,(%mref ,%sp ,return-stack-offset))])) [else `(set! ,%Cretval ,(%mref ,%sp ,return-stack-offset))]))
(list %Cretval) (list %Cretval)
4)])]))] 4)])]))]

8
s/ftype.ss
View File

@ -122,7 +122,7 @@ notes:
big-endian machines, the first field occupies the high-order bits, big-endian machines, the first field occupies the high-order bits,
with each subsequent field just below the preceding field. with each subsequent field just below the preceding field.
- ftype pointers are records encapsulating an ftype descriptor - ftyp<e pointers are records encapsulating an ftype descriptor
(ftd) along with the address of the foreign object, except that (ftd) along with the address of the foreign object, except that
pointers of type void* are just addresses. the encapsulated pointers of type void* are just addresses. the encapsulated
ftd is used to verify the applicability of an ftype-&ref, ftd is used to verify the applicability of an ftype-&ref,
@ -957,6 +957,12 @@ ftype operators:
(or (ftd-struct? x) (or (ftd-struct? x)
(ftd-union? x) (ftd-union? x)
(ftd-array? x)))) (ftd-array? x))))
(set! $ftd-unsigned?
(lambda (x)
(and (ftd-base? x)
(case (ftd-base-type x)
[(unsigned-8 unsigned-16 unsigned-32 unsigned-64) #t]
[else #f]))))
(set! $ftd->members (set! $ftd->members
(lambda (x) (lambda (x)
;; Currently used for x86_64 and arm32 ABI: Returns a list of ;; Currently used for x86_64 and arm32 ABI: Returns a list of

1
s/primdata.ss
View File

@ -2098,6 +2098,7 @@
($ftd-atomic-category [flags single-valued]) ($ftd-atomic-category [flags single-valued])
($ftd-compound? [sig [(sub-ptr) -> (boolean)]] [flags discard]) ($ftd-compound? [sig [(sub-ptr) -> (boolean)]] [flags discard])
($ftd-size [flags single-valued]) ($ftd-size [flags single-valued])
($ftd-unsigned? [flags single-valued])
($ftd->members [flags single-valued]) ($ftd->members [flags single-valued])
($ftype-guardian-oops [flags]) ($ftype-guardian-oops [flags])
($ftype-pointer? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable]) ($ftype-pointer? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable])