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

Merge branch 'fpstr' of github.com:mflatt/ChezScheme

Browse Source 
original commit: 871ccfa8688baa865731e047c59677b652d808f3
This commit is contained in:
Matthew Flatt 2019-02-01 05:26:06 -07:00
commit 627c809de4
4 changed files with 36 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
LOG
View File

@ -1087,3 +1087,6 @@
5_4.ss, 5_4.ms
- added enable-arithmetic-left-associative
cp0.ss, compile.ss, primdata.ss, front.ss, cp0.ms, system.stex
- fix allocation of string/bytevector for a foreign-callable argument
or foreign-call return
cpnanopass.ss, foreign.ms, foreign2.c

23
mats/foreign.ms
View File

@ -2539,6 +2539,29 @@
v)
14995143)
;; regression test related to saving registers that hold allocated
;; callable argument
(let* ([call-with-many-args (foreign-procedure "call_with_many_args" (void*) boolean)]
[result #f]
[cb (foreign-callable
(lambda (i s1 s2 s3 s4 i2 s6 s7 i3)
(set! result
(and (eqv? i 0)
(equal? (string->utf8 "this") s1)
(equal? (string->utf8 "is") s2)
(equal? (string->utf8 "working") s3)
(equal? (string->utf8 "just") s4)
(eqv? i2 1)
(equal? (string->utf8 "fine") s6)
(equal? (string->utf8 "or does it?") s7)
(eqv? i3 2))))
(int u8* u8* u8* u8* int u8* u8* int)
void)])
(lock-object cb)
(call-with-many-args (foreign-callable-entry-point cb))
(unlock-object cb)
result)
)
(machine-case

7
mats/foreign2.c
View File

@ -443,3 +443,10 @@ EXPORT void call_many_times(void (*f)(iptr))
j = k+2; k = l+2; l = m+2; m = m+2;
}
}
typedef void (*many_arg_callback_t)(int i, const char* s1, const char* s2, const char* s3,
const char* s4, int i2, const char* s6, const char* s7, int i3);
EXPORT void call_with_many_args(many_arg_callback_t callback)
{
callback(0, "this", "is", "working", "just", 1, "fine", "or does it?", 2);
}

7
s/cpnanopass.ss
View File

@ -905,9 +905,9 @@
(constant-case ptr-bits
[(32) (declare-intrinsic dofretuns64 dofretuns64 (%ts %td %xp) (%ac0 %ac1) (%ac0))]
[(64) (declare-intrinsic dofretuns64 dofretuns64 (%ts %td %xp) (%ac0) (%ac0))])
(declare-intrinsic dofretu8* dofretu8* (%ac0 %ts %td %cp) (%ac0) (%xp))
(declare-intrinsic dofretu16* dofretu16* (%ac0 %ts %td %cp) (%ac0) (%xp))
(declare-intrinsic dofretu32* dofretu32* (%ac0 %ts %td %cp) (%ac0) (%xp))
(declare-intrinsic dofretu8* dofretu8* (%ac0 %ts %td %cp %ac1) (%ac0) (%xp))
(declare-intrinsic dofretu16* dofretu16* (%ac0 %ts %td %cp %ac1) (%ac0) (%xp))
(declare-intrinsic dofretu32* dofretu32* (%ac0 %ts %td %cp %ac1) (%ac0) (%xp))
(declare-intrinsic get-room get-room () (%xp) (%xp))
(declare-intrinsic scan-remembered-set scan-remembered-set () () ())
(declare-intrinsic reify-cc reify-cc (%xp %ac0 %ts) () (%td))
@ -12457,7 +12457,6 @@
(set! ,%xp (literal ,(make-info-literal #f 'object #vu8() 0)))
(asm-return ,return-live* ...))
,(%seq
; TODO: avoid use of ac1 by insisting that get-room preserve ts & td
(set! ,(ref-reg %ac1) ,%td)
(set! ,%td ,(%inline + ,%td
(immediate