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

remove $make-shift-attachment

Browse Source 
original commit: 029c8a278e80eeedfab205849eaef4c8f4f599d6
This commit is contained in:
Gustavo Massaccesi 2019-03-27 10:20:02 -03:00
parent 82837d6d45
commit 191a4f3c49
2 changed files with 0 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
s/cpnanopass.ss
View File

@ -2827,32 +2827,6 @@
,[e*] ...) ,[e*] ...)
(guard (and (eq? (primref-name pr) '$top-level-value) (symbol? d))) (guard (and (eq? (primref-name pr) '$top-level-value) (symbol? d)))
`(call ,info0 ,mdcl0 ,(Symref d) ,e* ...)] `(call ,info0 ,mdcl0 ,(Symref d) ,e* ...)]
[(call ,info0 ,mdcl0
(call ,info1 ,mdcl1 ,pr
(call ,info2 ,mdcl2 ,pr2 (quote ,d)))
,[e*] ...)
(guard (and (eq? (primref-name pr) '$make-shift-attachment)
(eq? (primref-name pr2) '$top-level-value) (symbol? d)))
`(call ,info0 ,mdcl0 (call ,info1 ,mdcl1 ,(Symref (primref-name pr)) ,(Symref d)) ,e* ...)]
[(call ,info ,mdcl (call ,info2 ,mdcl2 ,pr0 ,pr) ,e* ...)
(guard (eq? (primref-name pr0) '$make-shift-attachment)
;; FIXME: need a less fragile way to avoid multiple results
;; Exclude inlined primitives that return more than one value:
(not (memq (primref-name pr) '(values call/cc call-with-current-continuation call/1cc))))
(cond
[(handle-prim (info-call-src info) (info-call-sexpr info) (primref-level pr) (primref-name pr) e*)
=> (lambda (e)
(let ([t (make-tmp 't)])
`(let ([,t ,(Expr e)])
(seq
(attachment-set pop)
,t))))]
[else
(let ([e* (map Expr e*)])
(let ([info (if (any-set? (prim-mask abort-op) (primref-flags pr))
(make-info-call (info-call-src info) (info-call-sexpr info) (info-call-check? info) #t #t)
info)])
`(call ,info ,mdcl (call ,info2 ,mdcl2 ,(Symref (primref-name pr0)) ,(Symref (primref-name pr))) ,e* ...)))])]
[(call ,info ,mdcl ,pr ,e* ...) [(call ,info ,mdcl ,pr ,e* ...)
(cond (cond
[(and [(and
@ -5711,18 +5685,6 @@
(bind #f (e-proc e-arity-mask e-data) (bind #f (e-proc e-arity-mask e-data)
(make-wrapper-closure-alloc e-proc e-arity-mask e-data (lookup-libspec arity-wrapper-apply)))])) (make-wrapper-closure-alloc e-proc e-arity-mask e-data (lookup-libspec arity-wrapper-apply)))]))
(define-inline 3 $make-shift-attachment
[(e-proc)
(bind #f (e-proc)
(bind #t ([c (%constant-alloc type-closure (fx* 3 (constant ptr-bytes)))])
(%seq
(set! ,(%mref ,c ,(constant closure-code-disp))
(literal ,(make-info-literal #f 'library
(lookup-libspec $shift-attachment)
(constant code-data-disp))))
(set! ,(%mref ,c ,(constant closure-data-disp)) ,e-proc)
,c)))])
(define-inline 3 $install-guardian (define-inline 3 $install-guardian
[(e-obj e-rep e-tconc ordered?) [(e-obj e-rep e-tconc ordered?)
(bind #f (e-obj e-rep e-tconc ordered?) (bind #f (e-obj e-rep e-tconc ordered?)

1
s/primdata.ss
View File

@ -2134,7 +2134,6 @@
($make-record-type #;[sig [(rtd maybe-rtd sub-ptr sub-list ptr ptr ptr ...) -> (rtd)]] [flags pure alloc cp02]) ($make-record-type #;[sig [(rtd maybe-rtd sub-ptr sub-list ptr ptr ptr ...) -> (rtd)]] [flags pure alloc cp02])
($make-relocation-table! [flags]) ($make-relocation-table! [flags])
($make-rnrs-libraries [flags]) ($make-rnrs-libraries [flags])
($make-shift-attachment [flags])
($make-source-oops [flags]) ($make-source-oops [flags])
($make-src-condition [flags]) ($make-src-condition [flags])
($make-textual-input/output-port #;[sig [(string port-handler string string) (string port-handler string string ptr) -> (textual-input/output-port)]] [flags alloc]) ($make-textual-input/output-port #;[sig [(string port-handler string string) (string port-handler string string ptr) -> (textual-input/output-port)]] [flags alloc])