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

continuing to isolate the bug. It looks like when we get the values back, we're somehow scrambling the order? Very strange

Browse Source
This commit is contained in:
Danny Yoo 2011-09-27 11:30:44 -04:00
parent e4f9481bc1
commit 40820a96b4
2 changed files with 15 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
compiler/compiler.rkt
View File

@ -397,7 +397,7 @@
(make-GotoStatement (ModuleEntry a-module-name)) (make-GotoStatement (ModuleEntry a-module-name))
on-return-multiple on-return-multiple
(make-PopEnvironment (new-SubtractArg (make-Reg 'argcount) (make-PopEnvironment (new-SubtractArg (make-Reg 'argcount)
(make-Const 1)) (make-Const 1))
(make-Const 0)) (make-Const 0))
on-return))])) on-return))]))
@ -596,7 +596,7 @@
(compile (first seq) cenv 'val return-linkage/nontail) (compile (first seq) cenv 'val return-linkage/nontail)
on-return/multiple on-return/multiple
(make-PopEnvironment (new-SubtractArg (make-Reg 'argcount) (make-PopEnvironment (new-SubtractArg (make-Reg 'argcount)
(make-Const 1)) (make-Const 1))
(make-Const 0)) (make-Const 0))
on-return on-return
(compile-splice (rest seq) cenv target linkage)))])) (compile-splice (rest seq) cenv target linkage)))]))
@ -660,7 +660,7 @@
(append-instruction-sequences (append-instruction-sequences
(make-PopEnvironment (make-Const (length cenv)) (make-PopEnvironment (make-Const (length cenv))
(new-SubtractArg (make-Reg 'argcount) (new-SubtractArg (make-Reg 'argcount)
(make-Const 1))) (make-Const 1)))
(make-AssignImmediateStatement 'proc (make-ControlStackLabel/MultipleValueReturn)) (make-AssignImmediateStatement 'proc (make-ControlStackLabel/MultipleValueReturn))
(make-PopControlFrame) (make-PopControlFrame)
(make-GotoStatement (make-Reg 'proc)))] (make-GotoStatement (make-Reg 'proc)))]
@ -845,7 +845,7 @@
(make-UnspliceRestFromStack! (make-UnspliceRestFromStack!
(make-Const (Lam-num-parameters exp)) (make-Const (Lam-num-parameters exp))
(new-SubtractArg (make-Reg 'argcount) (new-SubtractArg (make-Reg 'argcount)
(make-Const (Lam-num-parameters exp))))) (make-Const (Lam-num-parameters exp)))))
empty-instruction-sequence)] empty-instruction-sequence)]
[maybe-install-closure-values : InstructionSequence [maybe-install-closure-values : InstructionSequence
(if (not (empty? (Lam-closure-map exp))) (if (not (empty? (Lam-closure-map exp)))
@ -1036,10 +1036,10 @@
(define (compile-kernel-primitive-application kernel-op exp cenv target linkage) (define (compile-kernel-primitive-application kernel-op exp cenv target linkage)
(let ([singular-context-check (emit-singular-context linkage)] (let ([singular-context-check (emit-singular-context linkage)]
[n (length (App-operands exp))]) [n (length (App-operands exp))])
(define expected-operand-types (define expected-operand-types
(kernel-primitive-expected-operand-types kernel-op n)) (kernel-primitive-expected-operand-types kernel-op n))
(: make-runtime-arity-mismatch-code (Arity -> InstructionSequence)) (: make-runtime-arity-mismatch-code (Arity -> InstructionSequence))
(define (make-runtime-arity-mismatch-code expected-arity) (define (make-runtime-arity-mismatch-code expected-arity)
;; We compile the code to generate a runtime arity error here. ;; We compile the code to generate a runtime arity error here.
@ -1067,11 +1067,11 @@
(make-Reg 'proc) (make-Reg 'proc)
expected-arity expected-arity
(make-Const n)))))) (make-Const n))))))
(cond (cond
[(IncorrectArity? expected-operand-types) [(IncorrectArity? expected-operand-types)
(make-runtime-arity-mismatch-code (IncorrectArity-expected expected-operand-types))] (make-runtime-arity-mismatch-code (IncorrectArity-expected expected-operand-types))]
[(not (= n (length expected-operand-types))) [(not (= n (length expected-operand-types)))
(make-runtime-arity-mismatch-code (length expected-operand-types))] (make-runtime-arity-mismatch-code (length expected-operand-types))]
@ -1099,7 +1099,7 @@
(not (redundant-check? dom known))) (not (redundant-check? dom known)))
expected-operand-types expected-operand-types
operand-knowledge)] operand-knowledge)]
[operand-poss [operand-poss
(simple-operands->opargs (map (lambda: ([op : Expression]) (simple-operands->opargs (map (lambda: ([op : Expression])
(adjust-expression-depth op n n)) (adjust-expression-depth op n n))
@ -1545,7 +1545,7 @@
nontail-jump-into-procedure nontail-jump-into-procedure
on-return/multiple on-return/multiple
(make-PopEnvironment (new-SubtractArg (make-Reg 'argcount) (make-PopEnvironment (new-SubtractArg (make-Reg 'argcount)
(make-Const 1)) (make-Const 1))
(make-Const 0)) (make-Const 0))
on-return)])] on-return)])]
@ -1611,7 +1611,7 @@
on-return/multiple on-return/multiple
;; if the wrong number of arguments come in, die ;; if the wrong number of arguments come in, die
(make-TestAndJumpStatement (make-TestZero (new-SubtractArg (make-Reg 'argcount) (make-TestAndJumpStatement (make-TestZero (new-SubtractArg (make-Reg 'argcount)
(make-Const context))) (make-Const context)))
after-value-check) after-value-check)
on-return on-return
(make-PerformStatement (make-PerformStatement

5
tests/more-tests/isolating-bug.rkt
View File

@ -21,9 +21,12 @@
(define-struct name (fields ...) kw ...) (define-struct name (fields ...) kw ...)
(let ([cnstr (lambda args (let ([cnstr (lambda args
(apply cnstr args))]) (apply cnstr args))])
(displayln names) ...
(values names ...))))))))])) (values names ...))))))))]))
(my-define-struct swf (f) #:mutable) (my-define-struct swf (f) #:mutable)
(displayln "---")
struct:swf
make-swf make-swf
swf? swf?
swf-f swf-f
set-swf-f!