Index: /branches/ia32/lisp-kernel/x86-spentry32.s =================================================================== --- /branches/ia32/lisp-kernel/x86-spentry32.s (revision 8465) +++ /branches/ia32/lisp-kernel/x86-spentry32.s (revision 8466) @@ -478,5 +478,5 @@ _endsubp(makes64) -/* xxx make lisp integer out of mm0 */ +/* xxx make lisp integer out of mm0? */ /* Make a lisp integer (probably a bignum) out of the %edx:%eax pair. */ /* We assume that the node_regs_mask in the TCR has been set to mark */ @@ -493,4 +493,5 @@ __(movd %mm1,misc_data_offset(%arg_z)) __(movl %edx,misc_data_offset+4(%arg_z)) + __(mark_as_node(%edx)) __(ret) _endfn @@ -867,24 +868,214 @@ _endsubp(keyword_args) -/* There are %nargs words of arguments on the stack; %imm0 contains the number */ -/* of non-keyword args pushed. It's possible that we never actually got */ -/* any keyword args, which would make things much simpler. */ - -/* On entry, temp1 contains a fixnum with bits indicating whether */ -/* &allow-other-keys and/or &rest was present in the lambda list. */ -/* Once we get here, we can use the arg registers. */ - -define([keyword_flags_aok_bit],[fixnumshift]) -define([keyword_flags_unknown_keys_bit],[fixnumshift+1]) -define([keyword_flags_rest_bit],[fixnumshift+2]) -define([keyword_flags_seen_aok_bit],[fixnumshift+3]) +/* There are %nargs words of arguments on the stack; %imm0 contains the */ +/* number of non-keyword args pushed. It's possible that we never actually */ +/* got any keyword args, which would make things much simpler. */ + +/* On entry, the upper half of %temp1 (aka %nargs) contains some bits */ +/* indicating whether &allow-other-keys and/or &rest was present in the */ +/* lambda list. We therefore need to access %nargs as a 16-bit register. */ + +/* Once we get here, we can use the arg registers. */ + +/* N.B.: %ra0 is %temp0, and must not be clobbered. */ + +define([keyword_flags_aok_bit],[16]) +define([keyword_flags_unknown_keys_bit],[17]) +define([keyword_flags_rest_bit],[18]) +define([keyword_flags_seen_aok_bit],[19]) _spentry(keyword_bind) - __(int $3) + __(movzwl %nargs_w,%arg_z) + __(subl %imm0,%arg_z) + __(jbe local_label(no_keyword_values)) + __(btl $word_shift,%arg_z) + __(jnc local_label(even)) + __(movl $nil_value,%arg_y) + __(movw %arg_z_w,%nargs_w) + __(testw %nargs_w,%nargs_w) + __(jmp 1f) +0: __(pop %arg_z) + __(push %ra0) /* aka temp0; temp0 can't be live while consing. */ + __(Cons(%arg_z,%arg_y,%arg_y)) + __(pop %ra0) /* the push/pop in a loop is disgusting. */ + __(subw $node_size,%nargs_w) +1: __(jnz 0b) + __(movl %arg_y,%arg_z) + __(movl $XBADKEYS,%arg_y) + __(set_nargs(2)) + __(jmp _SPksignalerr) + + /* Now that we're sure that we have an even number of */ + /* keywords and values (in %arg_z), move the pairs over */ + /* to the temp stack. */ +local_label(even): + __(lea tsp_frame.fixed_overhead(%arg_z),%arg_y) + __(TSP_Alloc_Var(%arg_y,%imm0)) +2: __(subl $node_size,%arg_y) + __(pop (%arg_y)) + __(cmpl %arg_y,%imm0) + __(jne 2b) + + /* Get the keyword vector into %arg_y, and its length into %imm0. */ + /* Push %imm0 pairs of NILs (representing value, supplied-p) */ + /* for each declared keyword. */ + __(movzwl misc_data_offset(%fn),%imm0) + __(movl misc_data_offset(%fn,%imm0,node_size),%arg_y) + __(vector_length(%arg_y,%imm0)) + __(jmp 4f) +3: __(push $nil_value) + __(push $nil_value) +4: __(subl $fixnumone,%imm0) + __(jge 3b) + + /* We can now push %ra0 (aka %temp0) and %nargs (aka %temp1) */ + /* in order to get a couple more registers to work with. */ + __(push %ra0) + __(push %nargs) + + /* At this point we have: */ + /* number of supplied keywords and values in %arg_z */ + /* keyword vector in %arg_y */ + __(vector_length(%arg_y,%imm0)) + __(push %imm0) /* count of declared keywords */ + __(push %arg_z) /* count of supplied keys and values */ + + /* For each declared keyword, iterate over the supplied k/v pairs */ + /* to see if it's supplied and what the value is. */ + /* checking to see if any */ + /* key-value pairs were unexpectedly supplied. */ + + __(movl %rcontext:tcr.save_tsp,%temp0) + __(addl $2*node_size,%temp0) /* skip frame overhead */ + /* %temp0: top of tstack (skipping frame overhead) */ + __(lea 4*node_size(%esp,%imm0,2),%temp1) + /* %temp1: word above 0th value/supplied-p pair on vstack */ + /* %arg_y: keyword vector */ + __(xorl %imm0,%imm0) + /* %imm0: index */ + /* %arg_z: temporary */ + + /* Iterate over supplied k/v pairs on tstack. See if key is */ + /* in the keyword vector. Copy value and set supplied-p on */ + /* vstack if found. */ + +local_label(tstack_loop): + __(movl (%temp0,%imm0,2),%arg_z) /* keyword */ + __(push %imm0) + __(xorl %imm0,%imm0) + __(cmpl $nrs.kallowotherkeys,%arg_z) + __(jne local_label(next_keyvect_entry)) + __(btsl $keyword_flags_seen_aok_bit,12(%esp)) + __(jc local_label(next_keyvect_entry)) + __(cmpl $nil_value,node_size(%temp0,%imm0,2)) + __(je local_label(next_keyvect_entry)) + __(btsl $keyword_flags_aok_bit,12(%esp)) + __(jmp local_label(next_keyvect_entry)) + /* loop through keyword vector */ +6: __(cmpl misc_data_offset(%arg_y,%imm0),%arg_z) + __(jne 7f) + /* Got a match; have we already seen this keyword? */ + __(negl %imm0) + __(cmpl $nil_value,-node_size*2(%temp1,%imm0,2)) + __(jne 9f) /* seen it, ignore this value */ + __(movl (%esp),%arg_z) + __(lea (%temp0,%arg_z,2),%arg_z) + __(movl node_size(%arg_z),%arg_z) /* value for this key */ + __(movl %arg_z,-node_size(%temp1,%imm0,2)) + __(movl $t_value,-node_size*2(%temp1,%imm0,2)) + __(jmp 9f) +7: __(addl $node_size,%imm0) +local_label(next_keyvect_entry): + __(cmpl %imm0,8(%esp)) + __(jne 6b) + /* Didn't match anything in the keyword vector. Is the keyword */ + /* :allow-other-keys? */ + __(cmpl $nrs.kallowotherkeys,%arg_z) + __(je 9f) /* :allow-other-keys is never "unknown" */ +8: __(btsl $keyword_flags_unknown_keys_bit,12(%esp)) +9: __(pop %imm0) + __(addl $fixnumone,%imm0) + __(movl %imm0,%arg_z) + __(shll $1,%arg_z) /* pairs of tstack words */ + __(cmpl %arg_z,0(%esp)) + __(jne local_label(tstack_loop)) + + __(pop %imm0) /* count of supplied keys and values */ + __(addl $node_size,%esp) + __(pop %nargs) + __(pop %ra0) + + /* If the function takes an &rest arg, or if we got an unrecognized */ + /* keyword and don't allow that, copy the incoming k/v pairs from */ + /* the temp stack back to the value stack. */ + __(btl $keyword_flags_rest_bit,%temp1) + __(jc 1f) + __(btl $keyword_flags_unknown_keys_bit,%temp1) + __(jnc 0f) + __(btl $keyword_flags_aok_bit,%temp1) + __(jnc 1f) + /* pop the tstack frame */ +0: __(discard_temp_frame(%imm0)) + __(jmp *%ra0) + + /* Copy the k/v pairs from the tstack back to the value stack, */ + /* either because the function takes an &rest arg or because */ + /* we need to signal an "unknown keywords" error. */ +1: __(movl %rcontext:tcr.save_tsp,%arg_z) + __(mov (%arg_z),%arg_y) + __(jmp 3f) +2: __(push (%arg_z)) + __(push node_size(%arg_z)) +3: __(addl $dnode_size,%arg_z) + __(cmpl %arg_z,%arg_y) + __(jne 2b) + __(discard_temp_frame(%arg_z)) + __(btl $keyword_flags_unknown_keys_bit,%temp1) + __(jnc 9f) + __(btl $keyword_flags_aok_bit,%temp1) + __(jc 9f) + /* Signal an "unknown keywords" error */ + __(movl %imm0,%nargs) + __(movl $nil_value,%arg_z) + __(test %nargs,%nargs) + __(push %ra0) + __(jmp 5f) +4: __(pop %arg_y) + __(Cons(%arg_y,%arg_z,%arg_z)) + __(subl $node_size,%nargs) +5: __(jnz 4b) + __(movl $XBADKEYS,%arg_y) + __(set_nargs(2)) + __(movl 0(%esp),%ra0) + __(jmp _SPksignalerr) +9: __(jmp *%ra0) + +/* No keyword value were provided. Access the keyword vector (which is the */ +/* 0th constant in %fn), determine its length N, and push N pairs of NILs. */ +/* N could be 0... */ + +local_label(no_keyword_values): + __(movzwl misc_data_offset(%fn),%imm0) + __(movl misc_data_offset(%fn,%imm0,node_size),%arg_y) + __(vector_length(%arg_y,%arg_z)) + __(movl $nil_value,%imm0) + __(jmp 1f) +0: __(push %imm0) + __(push %imm0) +1: __(subl $fixnumone,%arg_z) + __(jge 0b) + __(jmp *%ra0) _endsubp(keyword_bind) +/* Normally, we'd just set %fname (aka %temp0) and do */ +/* jump_fname(). Sometimes, though, %temp0 is being used */ +/* as %ra0, and I'm not sure that it's going to be safe to */ +/* clobber that. (Note that nil-relative symbols aren't going */ +/* get moved around by the GC, so we can get away with putting */ +/* '%err-disp in %imm0.) */ _spentry(ksignalerr) - __(mov $nrs.errdisp,%fname) - __(jump_fname) + __(mov $nrs.errdisp,%imm0) + __(mov symbol.fcell(%imm0),%fn) + __(jump_fn) _endsubp(ksignalerr) @@ -1191,6 +1382,23 @@ _endsubp(restoreintlevel) +/* Make a lisp integer from the unsigned value in imm0 */ _spentry(makeu32) - __(int $3) + __(cmpl $(1<<29),%imm0) + __(jae 0f) /* need to make a bignum */ + __(box_fixnum(%imm0,%arg_z)) + __(ret) +0: __(movd %imm0,%mm1) + __(test %imm0,%imm0) + __(js 1f) + __(movl $one_digit_bignum_header,%imm0) + __(movd %imm0,%mm0) + __(Misc_Alloc_Fixed(%arg_z,aligned_bignum_size(1))) + __(movd %mm1,misc_data_offset(%arg_z)) + __(ret) +1: __(movl $two_digit_bignum_header,%imm0) + __(movd %imm0,%mm0) + __(Misc_Alloc_Fixed(%arg_z,aligned_bignum_size(2))) + __(movd %mm1,misc_data_offset(%arg_z)) + __(ret) _endsubp(makeu32) @@ -1310,9 +1518,29 @@ __(jo,pn C(fix_one_bit_overflow)) __(repret) - __(int $3) + __(jump_builtin(_builtin_minus,2)) _endsubp(builtin_minus) +/* %arg_z -< arg_y * arg_z. */ +/* Do the fixnum case---including overflow---inline. Call out otherwise. */ _spentry(builtin_times) - __(int $3) + __(movl %arg_y,%imm0) + __(orb %arg_z_b,%imm0_b) + __(testb $fixnummask,%imm0_b) + __(jne 2f) + __(unbox_fixnum(%arg_z,%imm0)) + __(mark_as_imm(%edx)) + /* 64-bit fixnum result in %edx:%eax. Overflow set if %edx */ + /* is significant. */ + __(imul %arg_y) + __(jo 1f) + __(movl %imm0,%arg_z) + __(mark_as_node(%edx)) + __(ret) +1: __(unbox_fixnum(%arg_z,%eax)) + __(unbox_fixnum(%arg_y,%edx)) + __(imul %edx) + /* SPmakes64 expects that %edx will be marked as an imm reg */ + __(jmp C(makes64)) +2: __(jump_builtin(_builtin_times,2)) _endsubp(builtin_times) @@ -1519,8 +1747,72 @@ _endsubp(builtin_aref1) +/* Maybe check the x87 tag word to see if st(0) is valid and pop it */ +/* if so. This might allow us to avoid having to have a priori */ +/* knowledge of whether a foreign function returns a floating-point result. */ +/* backlink to saved %esp, below */ +/* arg n-1 */ +/* arg n-2 */ +/* ... */ +/* arg 0 */ +/* space for alignment */ +/* previous %esp */ + _spentry(ffcall) - __(int $3) +LocalLabelPrefix[]ffcall: + __(unbox_fixnum(%arg_z,%imm0)) + __(testb $fixnummask,%arg_z_b) + __(je 0f) + __(movl macptr.address(%arg_z),%imm0) +0: + /* Save lisp registers. */ + __(push %ebp) + __(mov %esp,%ebp) + __(push %temp0) + __(push %temp1) + __(push %arg_y) + __(push %arg_z) + __(push %fn) + __(movl %esp,%rcontext:tcr.save_vsp) + __(movl %ebp,%rcontext:tcr.save_ebp) + __(movl $TCR_STATE_FOREIGN,%rcontext:tcr.valence) + __(movl %rcontext:tcr.foreign_sp,%esp) + __(stmxcsr %rcontext:tcr.lisp_mxcsr) + __(emms) + __(ldmxcsr %rcontext:tcr.foreign_mxcsr) + __(movl (%esp),%ebp) +LocalLabelPrefix[]ffcall_setup: + __(addl $node_size,%esp) +LocalLabelPrefix[]ffcall_call: + __(call *%eax) +LocalLabelPrefix[]ffcall_call_end: + __(movl %ebp,%esp) + __(movl %esp,%rcontext:tcr.foreign_sp) + __(clr %arg_z) + __(clr %arg_y) + __(clr %temp1) + __(clr %temp0) + __(clr %fn) + __(pxor %fpzero,%fpzero) + __ifdef([DARWIN]) + /* Darwin's math library seems to cause spurious FP exceptions. */ + __(movl %arg_z,%rcontext:tcr.ffi_exception) + __else + __(stmxcsr %rcontext:tcr.ffi_exception) + __endif + __(movl %rcontext:tcr.save_vsp,%esp) + __(movl %rcontext:tcr.save_ebp,%ebp) + __(movl $TCR_STATE_LISP,%rcontext:tcr.valence) + __(pop %fn) + __(pop %arg_z) + __(pop %arg_y) + __(pop %temp1) + __(ldmxcsr %rcontext:tcr.lisp_mxcsr) + __(check_pending_interrupt(%temp0)) + __(pop %temp0) + __(leave) + __(ret) + /* need to deal with NSExceptions and Objc-2.0 execptions */ _endsubp(ffcall) - + _spentry(ffcall_return_registers) __(int $3)