← Back to branch summary

~derick-eddington/ikarus/ikarus.dev--SRFI-104

« back to all changes in this revision

Viewing changes to scheme/ikarus.compiler.ss

  • Committer: Derick Eddington
  • Date: 2010-01-22 16:28:10 UTC
  • Revision ID: derick.eddington@gmail.com-20100122162810-2rfaj3ybt504wv0z
Update to Ikarus revision 1868.

Show diffs side-by-side

added added

removed removed

Lines of Context:
scheme/ikarus.compiler.ss
2104
2104
        (let ([L_cwv_done (gensym)]
2105
2105
              [L_cwv_loop (gensym)]
2106
2106
              [L_cwv_multi_rp (gensym)]
2107
 
              [L_cwv_call (gensym)])
 
2107
              [L_cwv_call (gensym)]
 
2108
              [SL_nonprocedure (gensym "SL_nonprocedure")]
 
2109
              [SL_invalid_args (gensym "SL_invalid_args")])
2108
2110
          (list 
2109
2111
              0 ; no free vars
2110
2112
              '(name call-with-values)
2111
2113
              (label SL_call_with_values)
2112
2114
              (cmpl (int (argc-convention 2)) eax)
2113
 
              (jne (label (sl-invalid-args-label)))
 
2115
              (jne (label SL_invalid_args))
2114
2116
              (movl (mem (fx- 0 wordsize) fpr) ebx) ; producer
2115
2117
              (movl ebx cpr)
2116
2118
              (andl (int closure-mask) ebx)
2117
2119
              (cmpl (int closure-tag) ebx)
2118
 
              (jne (label (sl-nonprocedure-error-label)))
 
2120
              (jne (label SL_nonprocedure))
2119
2121
              (movl (int (argc-convention 0)) eax)
2120
2122
              (compile-call-frame
2121
2123
                 3
2129
2131
              (movl (int (argc-convention 1)) eax)
2130
2132
              (andl (int closure-mask) ebx)
2131
2133
              (cmpl (int closure-tag) ebx)
2132
 
              (jne (label (sl-nonprocedure-error-label)))
 
2134
              (jne (label SL_nonprocedure))
2133
2135
              (tail-indirect-cpr-call)
2134
2136
              ;;; multiple values returned
2135
2137
              (label L_cwv_multi_rp)
2153
2155
              (movl cpr ebx)
2154
2156
              (andl (int closure-mask) ebx)
2155
2157
              (cmpl (int closure-tag) ebx)
2156
 
              (jne (label (sl-nonprocedure-error-label)))
2157
 
              (tail-indirect-cpr-call)))))
 
2158
              (jne (label SL_nonprocedure))
 
2159
              (tail-indirect-cpr-call)
 
2160
 
 
2161
              (label SL_nonprocedure)
 
2162
              (movl cpr (mem (fx- 0 wordsize) fpr)) ; first arg
 
2163
              (movl (obj (primref->symbol '$apply-nonprocedure-error-handler)) cpr)
 
2164
              (movl (mem (- disp-symbol-record-proc record-tag) cpr) cpr)
 
2165
              (movl (int (argc-convention 1)) eax)
 
2166
              (tail-indirect-cpr-call)
 
2167
 
 
2168
              (label SL_invalid_args)
 
2169
              ;;;
 
2170
              (movl cpr (mem (fx- 0 wordsize) fpr)) ; first arg
 
2171
              (negl eax)
 
2172
              (movl eax (mem (fx- 0 (fx* 2 wordsize)) fpr))
 
2173
              (movl (obj (primref->symbol '$incorrect-args-error-handler)) cpr)
 
2174
              (movl (mem (- disp-symbol-record-proc record-tag) cpr) cpr)
 
2175
              (movl (int (argc-convention 2)) eax)
 
2176
              (tail-indirect-cpr-call)
 
2177
 
 
2178
              ))))
2158
2179
    SL_call_with_values]
2159
2180
   ))
2160
2181