Index: /branches/arm/lisp-kernel/ARM-notes.txt =================================================================== --- /branches/arm/lisp-kernel/ARM-notes.txt (revision 13686) +++ /branches/arm/lisp-kernel/ARM-notes.txt (revision 13687) @@ -85,4 +85,15 @@ callee-save NVRs. +There are some cases in the runtime where we effectively want +to exchange the lr with the saved lr value in a stack frame. It's +possible to do this with a "swp" instruction; "swp" as a means +of doing interlocked memory operations has been deprecated in +ARMv6 and later. We don't care about those semantics, and if +there are only a few places (calling UNWIND-PROTECT cleanup +forms) that need to do this it's probably better to use "swp" +rather than inventing a scheme that allows some register to +be temporarily treated as a locative. + + - Subprim calls @@ -200,2 +211,11 @@ [explain complexity here ...] + + + - misc + +I -hope- that the altstack mechanism works on all platforms and that +we don't have to explicitly check for stack overflow on r13. (If it +does, we probably want to check for r13 overflow in the altstack/Mach +fault handler and unprotect pages there.) + Index: /branches/arm/lisp-kernel/arm-asmutils.s =================================================================== --- /branches/arm/lisp-kernel/arm-asmutils.s (revision 13686) +++ /branches/arm/lisp-kernel/arm-asmutils.s (revision 13687) @@ -20,66 +20,19 @@ _beginfile -/* Zero R4 cache lines, starting at address in R3. Each line is assumed to be */ -/* R5 bytes wide. */ -_exportfn(C(zero_cache_lines)) - __(cmpri(cr0,r4,0)) - __(mtctr r4) - __(beqlr) -1: - __(DCBZL(0,r3)) - __(add r3,r3,r5) - __(bdnz 1b) - __(blr) -_endfn -/* Flush R4 cache lines, starting at address in R3. Each line is */ -/* assumed to be R5 bytes wide. */ -_exportfn(C(flush_cache_lines)) - __(cmpri(cr0,r4,0)) - __(mtctr r4) - __(mr r6,r3) - __(beqlr) -1: - __(dcbst 0,r3) - __(add r3,r3,r5) - __(bdnz 1b) - __(sync) /* wait until dcbst's get to memory */ - __(mr r3,r6) - __(mtctr r4) -2: - __(icbi 0,r3) - __(add r3,r3,r5) - __(bdnz 2b) - __(sync) - __(isync) - __(blr) -/* The strange reference to "exp" is supposed to force the kernel to */ -/* load libm, so lisp code can use it. Under Darwin, the functionality */ -/* of libm is contained in libsystem, along with libc & everything else. */ +/* Force data from r0 to r1 into the icache */ +_exportfn(C(_make_data_executable)) + __(mov r2,#0) /* options. Pass as 0 until we know better */ + __(mov r12,r7) /* preserve r7 ; r12 saved by syscall */ + __(mov r7,0x0f0000) /* __ARM_NR_cacheflush */ + __(add r7,r7,#2) + __(svc #0) + __(mov r7,r12) + __(bx lr) - __ifndef(`DARWIN') - .data - __ifdef(`PPC64') - .quad exp - __else - .long exp - __endif - .text - __endif -_endfn - -_exportfn(C(touch_page)) - __(str(r3,0(r3))) - __(li r4,0) - __(str(r4,0(r3))) - __(li r3,1) /* can't assume that low 32 bits of r3 are non-zero */ - .globl C(touch_page_end) -C(touch_page_end): - __(blr) -_endfn _exportfn(C(current_stack_pointer)) - __(mr r3,sp) - __(blr) + __(mr r0,sp) + __(bx lr) _endfn @@ -90,26 +43,7 @@ _exportfn(C(noop)) - __(blr) + __(bx lr) _endfn -_exportfn(C(set_fpscr)) - __(stru(sp,-32(sp))) - __(stw r3,12(sp)) - __(lfd f0,8(sp)) - __(mtfsf 0xff,f0) - __(la sp,32(sp)) - __(blr) -_endfn - - -_exportfn(C(get_fpscr)) - __(stru(sp,-32(sp))) - __(mffs f0) - __(stfd f0,8(sp)) - __(lwz r3,12(sp)) - __(la sp,32(sp)) - __(blr) -_endfn - @@ -120,15 +54,25 @@ _exportfn(C(store_conditional)) - __(mr r6,r3) -1: __(lrarx(r3,0,r6)) - __(cmpw r3,r4) - __(bne- 2f) - __(strcx(r5,0,r6)) - __(bne- 1b) - __(isync) - __(blr) -2: __(li r0,RESERVATION_DISCHARGE) - __(strcx(r0,0,r0)) - __(blr) + __ifdef([LINUX]) + /* To deal with different ARM variants, Linux provides + a magic kernel function that does the right thing in + the absence of ldrex/strex/clrex and memory-barrier + functions. That function takes args in a different + order (r0 = expected oldval, r1 = newval, r2 = addr.) + */ + __(stmdb pc!,{r4,lr}) + __(eor r0,r0,r2) + __(eor r2,r2,r0) + __(eor r0,r0,r2) +0: __(ldr r3,[r2]) + __(cmp r3,r0) + __(bne 1f) + __(mov lr,#0xffff0fff) + __(add lr,lr,#(0xffff0fc0 - 0xffff0fff)) + __(blx lr) + __(bcc 0b) +1: __(mov r0,r3) + __(ldmia pc!,{r4,lr}) + __endif _endfn Index: /branches/arm/lisp-kernel/arm-constants.s =================================================================== --- /branches/arm/lisp-kernel/arm-constants.s (revision 13686) +++ /branches/arm/lisp-kernel/arm-constants.s (revision 13687) @@ -44,16 +44,20 @@ /* registers. These assignments may not be viable. */ -define(`arg_z',`r0') -define(`arg_y',`r1') -define(`arg_x',`r2') -define(`temp0',`r3') -define(`temp1',`r4') -define(`temp2',`r5') -define(`imm0',`r6') /* even, so ldrd/strd can use imm0/imm1 */ -define(`imm1',`r7') -define(`imm2',`r9') -define(`vsp',`r9') -define(`fn',`r10') -define(`rcontext',`r11') +define(`imm0',`r0') /* even, so ldrd/strd can use imm0/imm1 */ +define(`imm1',`r1') +define(`imm2',`r2') +/* rcontext = r3 can be used as an imm reg in certain contexts + (its value must be easily recovered, but that value never changes + during a thread's lifetime.) +*/ +define(`rcontext',`r3') +define(`arg_z',`r4') +define(`arg_y',`r5') +define(`arg_x',`r6') +define(`temp0',`r7') +define(`temp1',`r8') +define(`temp2',`r9') +define(`vsp',`r10') +define(`fn',`r11') define(`allocptr',`r12') define(`sp',`r13') @@ -658,5 +662,5 @@ define(`whole_reg',`temp1') -define(`arg_reg',`temp3') +define(`arg_reg',`temp0') define(`keyvect_reg',`temp2') define(`mask_req_start',`24') Index: /branches/arm/lisp-kernel/arm-macros.s =================================================================== --- /branches/arm/lisp-kernel/arm-macros.s (revision 13686) +++ /branches/arm/lisp-kernel/arm-macros.s (revision 13687) @@ -214,4 +214,13 @@ ') +define(`vpush_all_argregs',` + __(stmdb vsp!,{arg_z,arg_y,arg_x}) + ') + +define(`vpop_all_argregs',` + __(ldmia vsp!,{arg_z,arg_y,arg_x}) + ') + + /* $1 = arg/temp reg for lisp_frame_marker, $2 = value for lisp_frame.savevsp */ @@ -414,9 +423,16 @@ ') +/* Stack-allocate an ivector; $1 = header, $0 = dnode-aligned + size in bytes. */ +define(`stack_allocate_ivector',` + __(str $1,[sp,-$2]!) + ') + + /* Stack-allocate an ivector and zero its contents; caller may change subtag of header after it's zeroed. $1 = header (tagged as subtag_u32_vector until zeroed), $2 = dnode- aligned size in bytes). Both $1 and $2 are modified here. */ -define(`stack_allocate_zeroed_word_vector',` +define(`stack_allocate_zeroed_ivector',` new_macro_labels() __(str $1,[sp,-$2]!) @@ -442,5 +458,5 @@ define(`check_pending_interrupt',` new_macro_labels() - __(ldr $1,tcr.tlb_pointer(rcontext)) + __(ldr $1,[rcontext,#tcr.tlb_pointer]) __(ldr $1,[$1,$INTERRUPT_LEVEL_BINDING_INDEX]) __(cmp $1,#0) @@ -465,9 +481,9 @@ __(cmp $2,#fulltag_immheader) __(extract_lowbyte($2,$1)) - __(mov $1,$1 lsr #num_subtag_bits) - __(moveq $1,$1 lsl #2) + __(mov $1,$1,lsr #num_subtag_bits) + __(moveq $1,$1,lsl #2) __(beq macro_label(bytes)) __(cmp $2,#max_32_bit_ivector_subtag) - __(movle $1,$1 lsl #2) + __(movle $1,$1,lsl #2) __(ble macro_label(bytes)) __(cmp $2,#max_8_bit_ivector_subtag) @@ -486,2 +502,61 @@ __(add $1,$1,$3) ') + +/* This may need to be inlined. $1=link, $2=saved sym idx, $3 = tlb, $4 = value */ +define(`do_unbind_to',` + __(ldr $1,[rcontext,#tcr.db_link]) + __(ldr $3,[rcontext,#tcr.tlb_pointer]) +1: __(ldr $2,[$1,#binding.sym]) + __(ldr $4,[$1,#binding.val]) + __(ldr $1,[$1,#binding.link]) + __(cmp imm0,$1) + __(str $4,[$3,$2]) + __(bne 1b) + __(str $1,[rcontext,#tcr.db_link]) + ') + +/* Linux provides a weird kernel entrypoint to do cmpxchg on hardware + that may not support it natively. Darwin only runs on ARMv6 hardware, + which can use ldrex/strex instructions to do cmpxchg inline. On + SMP hardware, the cmpxchg should be followe by a 'dmb' (data memory + barrier) instruction, which is only available on ARMv7. Confused yet? + The Linux kernel function clobbers some registers, and we may need + some support in pc_luser_xp() to fix things up at interrupt/suspend + time. + Generally, imm1 = mask with exactly one bit set, *imm2 = address of + refbits word. */ + +define(`set_ref_bit',` + new_macro_labels() + __ifdef(`LINUX') + .globl set_ref_bit_entry_$1 +set_ref_bit_entry_$1: + __(build_lisp_frame(imm0)) /* we clobber lr */ + __(mov temp1,imm1) + __(mov temp2,rcontext) +macro_label(again): + __(ldr lr,macro_label(linux_kernel_cmpxchg)) + __(ldr r0,[r2]) + __(orr r1,r0,temp1) + __(blx lr) + .globl set_ref_bit_return_$1 +set_ref_bit_return_$1: + __(mov rcontext,temp2) + __(ldr allocptr,[rcontext,#tcr.save_allocptr]) + __(bcc macro_label(again)) + __(restore_lisp_frame(imm0)) + __(b macro_label(continue)) +macro_label(linux_kernel_cmpxchg): + .word 0xffff0fc0 /* magic address */ +macro_label(continue): + __endif + __ifdef(`DARWIN') +macro_label(again): + __(ldrex r0,[r2]) + __(orr r0,r0,r1) + __(strex r0,r0,[r2]) + __(cmp r0,#0) + __(bne macro_label(again)) + __endif + ') + Index: /branches/arm/lisp-kernel/arm-spentry.s =================================================================== --- /branches/arm/lisp-kernel/arm-spentry.s (revision 13686) +++ /branches/arm/lisp-kernel/arm-spentry.s (revision 13687) @@ -46,4 +46,281 @@ ') +_spentry(builtin_plus) + __(test_two_fixnums(arg_y,arg_z,imm0)) + __(bne 1f) + __(adds arg_z,arg_y,arg_z) + __(bxvc lr) + __(b _SPfix_overflow) +1: + __(jump_builtin(_builtin_plus,2)) + +_spentry(builtin_minus) + __(test_two_fixnums(arg_y,arg_z,imm0)) + __(bne 1f) + __(subs arg_z,arg_y,arg_z) + __(bxvc lr) + __(b _SPfix_overflow) +1: + __(jump_builtin(_builtin_minus,2)) + +_spentry(builtin_times) + __(test_two_fixnums(arg_y,arg_z,imm0)) + __(bne 1f) + __(unbox_fixnum(imm2,arg_z)) + __(smull arg_z,imm1,imm2,arg_y) + /* Now have a "64-bit fixnum" in imm1(high) and arg_z(low). If */ + /* imm1 is just a sign extension of arg_z, return arg_z */ + __(cmp imm1,arg_z,asr #(nbits_in_word-1)) + __(bxeq lr) + /* Need to ashift the pair imm1:imm0 right fixnumshift bits */ + __(mov imm0,imm0,lsr #fixnumshift) + __(and imm2,imm1,#fixnummask) + __(orr imm0,imm0,imm2,lsl #(nbits_in_word-fixnumshift)) + __(unbox_fixnum(imm1,imm1)) + __(b _SPmakes64) + +1: __(jump_builtin(_builtin_times,2)) + +_spentry(builtin_div) + __(jump_builtin(_builtin_div,2)) + +_spentry(builtin_eq) + __(test_two_fixnums(arg_y,arg_z,imm0)) + __(bne 1f) + __(cmp arg_y,arg_z) + __(mov arg_z,#nil_value) + __(addeq arg_z,arg_z,#t_offset) + __(bx lr) +1: + __(jump_builtin(_builtin_eq,2)) + +_spentry(builtin_ne) + __(test_two_fixnums(arg_y,arg_z,imm0)) + __(bne 1f) + __(cmp arg_y,arg_z) + __(mov arg_z,#nil_value) + __(addne arg_z,arg_z,#t_offset) + __(bx lr) +1: + __(jump_builtin(_builtin_ne,2)) + +_spentry(builtin_gt) + __(test_two_fixnums(arg_y,arg_z,imm0)) + __(bne 1f) + __(cmp arg_y,arg_z) + __(mov arg_z,#nil_value) + __(addgt arg_z,arg_z,#t_offset) + __(bx lr) +1: + __(jump_builtin(_builtin_gt,2)) + +_spentry(builtin_ge) + __(test_two_fixnums(arg_y,arg_z,imm0)) + __(bne 1f) + __(cmp arg_y,arg_z) + __(mov arg_z,#nil_value) + __(addge arg_z,arg_z,#t_offset) + __(bx lr) +1: + __(jump_builtin(_builtin_ge,2)) + +_spentry(builtin_lt) + __(test_two_fixnums(arg_y,arg_z,imm0)) + __(bne 1f) + __(cmp arg_y,arg_z) + __(mov arg_z,#nil_value) + __(addgt arg_z,arg_z,#t_offset) + __(bx lr) +1: + __(jump_builtin(_builtin_lt,2)) + +_spentry(builtin_le) + __(test_two_fixnums(arg_y,arg_z,imm0)) + __(bne 1f) + __(cmp arg_y,arg_z) + __(mov arg_z,#nil_value) + __(addle arg_z,arg_z,#t_offset) + __(bx lr) +1: + __(jump_builtin(_builtin_le,2)) + +_spentry(builtin_eql) + __(cmp arg_y,arg_z) + __(beq 1f) + __(extract_fulltag(imm0,arg_y)) + __(extract_fulltag(imm1,arg_z)) + __(cmp imm0,imm1) + __(bne 2f) + __(cmp imm0,#fulltag_misc) + __(bne 2f) + __(jump_builtin(_builtin_eql,2)) +1: __(mov arg_z,#nil_value) + __(add arg_z,arg_z,#t_offset) + __(bx lr) +2: __(mov arg_z,#nil_value) + __(bx lr) + +_spentry(builtin_length) + __(extract_typecode(imm0,arg_z)) + __(cmp imm0,#min_vector_subtag) + __(ldreq arg_z,[arg_z,#vectorH.logsize]) + __(bxeq lr) + __(blo 1f) + __(vector_length(arg_z,arg_z,imm0)) + __(bx lr) +1: __(cmp imm0,#tag_list) + __(bne 8f) + __(mov temp2,#-1< imm0 if &rest/&key is involved. */ -dnl _spentry(opt_supplied_p) -dnl __(mov imm1,#0) -dnl 1: -dnl /* (vpush (< imm1 nargs)) */ -dnl __(xor imm2,imm1,nargs) -dnl __(srawi imm2,imm2,31) -dnl __(or imm2,imm2,imm1) -dnl __(addi imm1,imm1,#fixnumone) -dnl __(cmpr(cr0,imm1,imm0)) -dnl __(subf imm2,nargs,imm2) -dnl __(srwi imm2,imm2,31) -dnl __(insrwi imm2,imm2,1,27) -dnl __(addi imm2,imm2,nil_value) -dnl __(vpush1(imm2)) -dnl __(bne cr0,1b) -dnl __(bx lr) -dnl -dnl -dnl +/* Indicate whether &optional arguments were actually supplied. nargs */ +/* contains the actual arg count (minus the number of required args); */ +/* imm0 contains the number of &optional args in the lambda list. */ +/* Note that nargs may be > imm0 if &rest/&key is involved. */ +_spentry(opt_supplied_p) + __(mov imm1,#0) + __(mov arg_x,#nil_value) + __(add arg_x,arg_x,#t_offset) +1: + /* (vpush (< imm1 nargs)) */ + __(cmp imm1,nargs) + __(subeq imm1,imm1,#t_offset) + __(vpush1(imm1)) + __(cmp imm1,imm0) + __(bne 1b) + __(bx lr) + /* Cons a list of length nargs and vpush it. */ /* Use this entry point to heap-cons a simple &rest arg. */ @@ -1304,6 +1350,6 @@ __(vpush1(arg_z)) __(bx lr) -dnl -dnl + + dnl _spentry(simple_keywords) dnl __(mov imm0,#0) @@ -1345,7 +1391,7 @@ dnl /* So, the number of args pushed so far is the larger of nargs */ dnl /* and the (canonical) total of required/&optional args received. */ -dnl __(cmpr(cr0,nargs,imm0)) +dnl __(cmpr(nargs,imm0)) dnl __(add arg_z,vsp,nargs) -dnl __(bge+ cr0,1f) +dnl __(bge+ 1f) dnl __(add arg_z,vsp,imm0) dnl 1: @@ -1358,5 +1404,5 @@ dnl /* If there aren't any such pairs, the first step is the last */ dnl /* step. */ -dnl __(cmpri(cr0,imm3,0)) +dnl __(cmp imm3,#0) dnl __(mov arg_z,#0) dnl __(sub imm1,nargs,imm0) @@ -1366,13 +1412,13 @@ dnl 2: dnl __(addi arg_z,arg_z,fixnum_one) -dnl __(cmplr(cr0,arg_z,imm3)) +dnl __(cmplr(arg_z,imm3)) dnl __(mov imm5,#nil_value) dnl __(vpush1(imm5)) dnl __(vpush1(imm5)) dnl 3: -dnl __(bne cr0,2b) +dnl __(bne 2b) dnl __(andi. arg_z,imm1,fixnum_one) dnl __(blelr cr1) /* no keyword/value pairs to consider. */ -dnl __(bne cr0,odd_keywords) +dnl __(bne odd_keywords) dnl /* We have key/value pairs. Move them to the top of the vstack, */ dnl /* then set the value/supplied-p vars to NIL. */ @@ -1393,5 +1439,5 @@ dnl __(mov imm4,#nil_value) dnl __(subi arg_z,arg_z,2< 1 (and we know that it was < 3), it must have */ -dnl /* been 2. Set arg_x, then vpush the remaining args. */ -dnl __(ble cr1,local_label(set_y_z)) -dnl local_label(set_arg_x): -dnl __(subi imm0,imm0,fixnum_one) -dnl __(cmpri(cr0,imm0,0)) -dnl __(subi imm2,imm2,fixnum_one) -dnl __(ldrx(arg_x,nfn,imm2)) -dnl __(addi nargs,nargs,fixnum_one) -dnl __(bne cr0,local_label(vpush_remaining)) -dnl __(b local_label(go)) -dnl /* Maybe set arg_y or arg_z, preceding args */ -dnl local_label(set_y_z): -dnl __(bne cr1,local_label(set_arg_z)) -dnl /* Set arg_y, maybe arg_x, preceding args */ -dnl local_label(set_arg_y): -dnl __(subi imm0,imm0,fixnum_one) -dnl __(cmpri(cr0,imm0,0)) -dnl __(subi imm2,imm2,fixnum_one) -dnl __(ldrx(arg_y,nfn,imm2)) -dnl __(addi nargs,nargs,fixnum_one) -dnl __(bne cr0,local_label(set_arg_x)) -dnl __(b local_label(go)) -dnl local_label(set_arg_z): -dnl __(subi imm0,imm0,fixnum_one) -dnl __(cmpri(cr0,imm0,0)) -dnl __(subi imm2,imm2,fixnum_one) -dnl __(ldrx(arg_z,nfn,imm2)) -dnl __(addi nargs,nargs,fixnum_one) -dnl __(bne cr0,local_label(set_arg_y)) -dnl -dnl local_label(go): -dnl __(vrefr(nfn,nfn,1)) -dnl __(ldr loc_pc,[nfn,#_function.codevector]) -dnl __(mtctr loc_pc) -dnl __(bctr) +/* Prepend all but the first three (entrypoint, closure code, fn) and last two */ +/* (function name, lfbits) elements of nfn to the "arglist". */ +/* functions which take "inherited arguments" work consistently */ +/* even in cases where no closure object is created. */ +_spentry(call_closure) + __(cmp nargs,nargregs< 1 (and we know that it was < 3), it must have */ + /* been 2. Set arg_x, then vpush the remaining args. */ + __(cmp nargs,#fixnumone) + __(ble local_label(set_y_z)) +local_label(set_arg_x): + __(subs imm0,imm0,#fixnum_one) + __(sub imm1,imm1,#fixnum_one) + __(ldr arg_x,[nfn,imm1]) + __(add nargs,nargs,#fixnum_one) + __(bne local_label(vpush_remaining)) + __(b local_label(go)) + /* Maybe set arg_y or arg_z, preceding args */ +local_label(set_y_z): + __(cmp nargs,#fixnumone) + __(bne local_label(set_arg_z)) + /* Set arg_y, maybe arg_x, preceding args */ +local_label(set_arg_y): + __(subs imm0,imm0,fixnum_one) + __(sub imm1,imm1,#fixnum_one) + __(ldr arg_y,[nfn,imm1]) + __(add nargs,nargs,#fixnum_one) + __(bne local_label(set_arg_x)) + __(b local_label(go)) +local_label(set_arg_z): + __(subs imm0,imm0,#fixnum_one) + __(sub imm1,imm1,#fixnum_one) + __(ldr arg_z,[nfn,imm1]) + __(add nargs,nargs,#fixnum_one) + __(bne local_label(set_arg_y)) + +local_label(go): + __(vrefr(nfn,nfn,2)) + __(ldr pc,[nfn,#_function.entrypoint]) @@ -1828,60 +1876,63 @@ __(b C(misc_ref_common)) -_spentry(builtin_aref1) - __(extract_typecode(imm0,arg_y)) - __(cmp imm0,#min_vector_subtag) - __(box_fixnum(arg_x,imm0)) - __(bgt _SPsubtag_misc_ref) - __(jump_builtin(_builtin_aref1,2)) - -dnl /* Make a "raw" area on the temp stack, stack-cons a macptr to point to it, */ -dnl /* and return the macptr. Size (in bytes, boxed) is in arg_z on entry; macptr */ -dnl /* in arg_z on exit. */ -dnl _spentry(makestackblock) -dnl __(unbox_fixnum(imm0,arg_z)) -dnl __(dnode_align(imm0,imm0,tsp_frame.fixed_overhead+macptr.size)) -dnl __(cmplri(cr0,imm0,tstack_alloc_limit)) -dnl __(bge cr0,1f) -dnl __(TSP_Alloc_Var_Unboxed(imm0)) -dnl __(mov imm0,#macptr_header) -dnl __(la imm1,tsp_frame.data_offset+macptr.size(tsp)) -dnl __(str(imm0,tsp_frame.data_offset(tsp))) -dnl __(la arg_z,tsp_frame.data_offset+fulltag_misc(tsp)) -dnl __(str(imm1,macptr.address(arg_z))) -dnl __(stfd fp_zero,macptr.domain(arg_z)) -dnl __(bx lr) -dnl -dnl /* Too big. Heap cons a gcable macptr */ -dnl 1: -dnl __(TSP_Alloc_Fixed_Unboxed(0)) -dnl __(set_nargs(1)) -dnl __(mov fname,#nrs.new_gcable_ptr) -dnl __(jump_fname()) -dnl -dnl /* As above, only set the block's contents to 0. */ -dnl _spentry(makestackblock0) -dnl __(unbox_fixnum(imm0,arg_z)) -dnl __(dnode_align(imm0,imm0,tsp_frame.fixed_overhead+macptr.size)) -dnl __(cmplri(cr0,imm0,tstack_alloc_limit)) -dnl __(bge cr0,3f) -dnl __(TSP_Alloc_Var_Unboxed(imm0)) -dnl __(Zero_TSP_Frame(imm0,imm1)) -dnl __(mov imm0,#macptr_header) -dnl __(la imm1,tsp_frame.data_offset+macptr.size(tsp)) -dnl __(str(imm0,tsp_frame.data_offset(tsp))) -dnl __(la arg_z,tsp_frame.data_offset+fulltag_misc(tsp)) -dnl __(str(imm1,macptr.address(arg_z))) /* makestackblock0 expects the address to be in imm1 */ -dnl __(stfd fp_zero,macptr.domain(arg_z)) -dnl __(bx lr) -dnl -dnl /* Too big. Heap cons a gcable macptr */ -dnl 3: -dnl __(TSP_Alloc_Fixed_Unboxed(0)) /* "raw" block to make the compiler happy */ -dnl -dnl __(mov arg_y,arg_z) /* save block size */ -dnl __(mov arg_z,#t_value) /* clear-p arg to %new-gcable-ptr */ -dnl __(set_nargs(2)) -dnl __(mov fname,#nrs.new_gcable_ptr) -dnl __(jump_fname()) + +/* Make a "raw" area on the temp stack, stack-cons a macptr to point to it, */ +/* and return the macptr. Size (in bytes, boxed) is in arg_z on entry; macptr */ +/* in arg_z on exit. */ +_spentry(makestackblock) + __(unbox_fixnum(imm1,arg_z)) + __(dnode_align(imm1,imm1,0)) + __(add imm1,imm1,#macptr.size+node_size) + __(add imm0,imm1,#node_size) + __(mov imm1,imm1,lsl #num_subtag_bits) + __(orr imm1,imm1,#subtag_u8_vector) + __(cmp imm0,#stack_alloc_limit) + __(bhs 1f) + __(stack_allocate_ivector(imm1,imm0)) + __(movc16(imm1,make_header(macptr.element_count,subtag_macptr))) + __(str imm1,[sp,#dnode_size]) + __(mov imm0,#0) + __(str imm0,[sp,#dnode_size+macptr.type-fulltag_misc]) + __(str imm0,[sp,#dnode_size+macptr.domain-fulltag_misc]) + __(add imm0,sp,#macptr.size+dnode_size) + __(str imm0,[sp,#dnode_size+macptr.address-fulltag_misc]) + __(add arg_z,sp,#dnode_size+fulltag_misc) + __(bx lr) + + /* Too big. Heap cons a gcable macptr */ +1: + __(mov imm1,#subtag_u8_vector) + __(str imm1,[sp,#-dnode_size]!) + __(set_nargs(1)) + __(ref_nrs_symbol(fname,new_gcable_ptr,imm0)) + __(jump_fname()) + +/* As above, only set the block's contents to 0. */ +_spentry(makestackblock0) + __(unbox_fixnum(imm1,arg_z)) + __(dnode_align(imm1,imm1,0)) + __(add imm1,imm1,#macptr.size+node_size) + __(add imm0,imm1,#node_size) + __(mov imm1,imm1,lsl #num_subtag_bits) + __(orr imm1,imm1,#subtag_u8_vector) + __(cmp imm0,#stack_alloc_limit) + __(bhs 1f) + __(stack_allocate_zeroed_ivector(imm1,imm0)) + __(movc16(imm1,make_header(macptr.element_count,subtag_macptr))) + __(str imm1,[sp,#dnode_size]) + __(add imm0,sp,#macptr.size+dnode_size) + __(str imm0,[sp,#dnode_size+macptr.address-fulltag_misc]) + __(add arg_z,sp,#dnode_size+fulltag_misc) + __(bx lr) + /* Too big. Heap cons a gcable macptr */ +1: + __(mov imm1,#subtag_u8_vector) + __(str imm1,[sp,#-dnode_size]!) + __(mov arg_y,arg_z) /* save block size */ + __(mov arg_z,#nil_value) /* clear-p arg to %new-gcable-ptr */ + __(add arg_z,arg_z,#t_offset) + __(set_nargs(2)) + __(ref_nrs_symbol(fname,new_gcable_ptr,imm0)) + __(jump_fname()) /* Make a list of length arg_y (boxed), initial-element arg_z (boxed) on */ @@ -1895,5 +1946,5 @@ __(cmp imm0,#stack_alloc_limit) __(bge 4f) - __(stack_allocate_zeroed_word_vector(imm1,imm0)) + __(stack_allocate_zeroed_ivector(imm1,imm0)) __(mov imm0,#subtag_simple_vector) __(strb imm0,[sp,#0]) @@ -1926,30 +1977,26 @@ __(bx lr) -dnl /* subtype (boxed) vpushed before initial values. (Had better be a */ -dnl /* node header subtag.) Nargs set to count of things vpushed. */ -dnl -dnl _spentry(stkgvector) -dnl __(la imm0,-fixnum_one(nargs)) -dnl __(cmpri(cr1,imm0,0)) -dnl __(add imm1,vsp,nargs) -dnl __(ldru(temp0,-node_size(imm1))) -dnl __(slri(imm2,imm0,num_subtag_bits-fixnumshift)) -dnl __(rlwimi imm2,temp0,32-fixnumshift,32-num_subtag_bits,31) -dnl __(dnode_align(imm0,imm0,node_size+tsp_frame.fixed_overhead)) -dnl __(TSP_Alloc_Var_Boxed_nz(imm0,imm3)) -dnl __(str(imm2,tsp_frame.data_offset(tsp))) -dnl __(la arg_z,tsp_frame.data_offset+fulltag_misc(tsp)) -dnl __(la imm3,misc_header_offset(arg_z)) -dnl __(mov imm0,#fixnum1) -dnl __(b 2f) -dnl 1: -dnl __(addi imm0,imm0,fixnum1) -dnl __(cmpr(cr1,imm0,nargs)) -dnl __(ldru(temp0,-node_size(imm1))) -dnl __(stru(temp0,node_size(imm3))) -dnl 2: -dnl __(bne cr1,1b) -dnl __(add vsp,vsp,nargs) -dnl __(bx lr) +/* subtype (boxed) vpushed before initial values. (Had better be a */ +/* node header subtag.) Nargs set to count of things vpushed. */ + +_spentry(stkgvector) + __(sub imm0,nargs,#fixnumone) + __(ldr temp0,[vsp,imm0]) + __(dnode_align(temp1,imm0,node_size)) + __(mov imm1,imm0,lsl #num_subtag_bits-fixnumshift) + __(orr imm1,imm1,#subtag_u32_vector) + __(stack_allocate_zeroed_ivector(imm1,temp1)) + __(unbox_fixnum(imm1,temp0)) + __(strb imm1,[sp]) + __(add arg_z,sp,#fulltag_misc) + __(add imm0,sp,nargs) + __(b 2f) +1: + __(vpop1(temp0)) + __(push1(temp0,imm0)) +2: __(subs nargs,nargs,#fixnumone) + __(bne 1b) + __(add vsp,vsp,#fixnumone) + __(bx lr) /* Allocate a "fulltag_misc" object. On entry, arg_y contains the element */ @@ -1994,255 +2041,42 @@ __(uuo_error_reg_not_xtype(al,arg_y,xtype_unsigned_byte_24)) -dnl -dnl -dnl /* Destructuring-bind, macro-bind. */ -dnl -dnl /* OK to use arg_x, arg_y for whatever (tagged) purpose; */ -dnl /* likewise immX regs. */ -dnl /* arg_z preserved, nothing else in particular defined on exit. */ -dnl /* nargs contains req count (0-255) in PPC bits mask_req_start/mask_req_width, */ -dnl /* opt count (0-255) in PPC bits mask_opt_start/mask_opt_width, */ -dnl /* key count (0-255) in PPC bits mask_key_start/mask_key_width, */ -dnl /* opt-supplied-p flag in PPC bit mask_initopt, */ -dnl /* keyp flag in PPC bit mask_keyp, */ -dnl /* &allow-other-keys flag in PPC bit mask_aok, */ -dnl /* &rest flag in PPC bit mask_restp. */ -dnl /* When mask_keyp bit is set, keyvect contains vector of keyword symbols, */ -dnl /* length key count. */ -dnl -dnl _spentry(macro_bind) -dnl __(mov whole_reg,arg_reg) -dnl __(extract_lisptag(imm0,arg_reg)) -dnl __(cmpri(cr0,imm0,tag_list)) -dnl __(bne- cr0,1f) -dnl __(_cdr(arg_reg,arg_reg)) -dnl __(b (local_label(destbind1))) -dnl 1: -dnl __(mov arg_y,#XCALLNOMATCH) -dnl __(mov arg_z,whole_reg) -dnl __(set_nargs(2)) -dnl __(b _SPksignalerr) -dnl -dnl -dnl _spentry(destructuring_bind) -dnl __(Mov whole_reg,arg_reg) -dnl __(b local_label(destbind1)) -dnl -dnl _spentry(destructuring_bind_inner) -dnl __(mov whole_reg,arg_z) -dnl local_label(destbind1): -dnl /* Extract required arg count. */ -dnl /* A bug in gas: can't handle shift count of "32" (= 0 */ -dnl ifelse(eval(mask_req_width+mask_req_start),eval(32),` -dnl __(clrlwi. imm0,nargs,mask_req_start) -dnl ',` -dnl __(extrwi. imm0,nargs,mask_req_width,mask_req_start) -dnl ') -dnl __(extrwi imm1,nargs,mask_opt_width,mask_opt_start) -dnl __(rlwinm imm2,nargs,0,mask_initopt,mask_initopt) -dnl __(rlwinm imm4,nargs,0,mask_keyp,mask_keyp) -dnl __(cmpri(cr4,imm4,0)) -dnl __(rlwinm imm4,nargs,0,mask_restp,mask_restp) -dnl __(cmpri(cr5,imm4,0)) -dnl __(cmpri(cr1,imm1,0)) -dnl __(cmpri(cr2,imm2,0)) -dnl /* Save entry vsp in case of error. */ -dnl __(mov imm4,vsp) -dnl __(beq cr0,2f) -dnl 1: -dnl __(cmpri(cr7,arg_reg,nil_value)) -dnl __(extract_lisptag(imm3,arg_reg)) -dnl __(cmpri(cr3,imm3,tag_list)) -dnl __(subi imm0,imm0,1) -dnl __(cmpri(cr0,imm0,0)) -dnl __(beq cr7,toofew) -dnl __(bne cr3,badlist) -dnl __(ldr arg_x,[arg_reg,#cons.car]) -dnl __(ldr arg_reg,[arg_reg,#cons.cdr]) -dnl __(vpush1(arg_x)) -dnl __(bne cr0,1b) -dnl 2: -dnl __(beq cr1,rest_keys) -dnl __(bne cr2,opt_supp) -dnl /* 'simple' &optionals: no supplied-p, default to nil. */ -dnl simple_opt_loop: -dnl __(cmpri(cr0,arg_reg,nil_value)) -dnl __(extract_lisptag(imm3,arg_reg)) -dnl __(cmpri(cr3,imm3,tag_list)) -dnl __(subi imm1,imm1,1) -dnl __(cmpri(cr1,imm1,0)) -dnl __(mov imm5,#nil_value) -dnl __(beq cr0,default_simple_opt) -dnl __(bne cr3,badlist) -dnl __(ldr arg_x,[arg_reg,#cons.car]) -dnl __(ldr arg_reg,[arg_reg,#cons.cdr]) -dnl __(vpush1(arg_x)) -dnl __(bne cr1,simple_opt_loop) -dnl __(b rest_keys) -dnl default_simple_opt_loop: -dnl __(subi imm1,imm1,1) -dnl __(cmpri(cr1,imm1,0)) -dnl default_simple_opt: -dnl __(vpush1(imm5)) -dnl __(bne cr1,default_simple_opt_loop) -dnl __(b rest_keys) -dnl /* Provide supplied-p vars for the &optionals. */ -dnl opt_supp: -dnl __(mov arg_y,#t_value) -dnl opt_supp_loop: -dnl __(cmpri(cr0,arg_reg,nil_value)) -dnl __(extract_lisptag(imm3,arg_reg)) -dnl __(cmpri(cr3,imm3,tag_list)) -dnl __(subi imm1,imm1,1) -dnl __(cmpri(cr1,imm1,0)) -dnl __(beq cr0,default_hard_opt) -dnl __(bne cr3,badlist) -dnl __(ldr arg_x,[arg_reg,#cons.car]) -dnl __(ldr arg_reg,[arg_reg,#cons.cdr]) -dnl __(vpush1(arg_x)) -dnl __(vpush1(arg_y)) -dnl __(bne cr1,opt_supp_loop) -dnl __(b rest_keys) -dnl default_hard_opt_loop: -dnl __(subi imm1,imm1,1) -dnl __(cmpri(cr1,imm1,0)) -dnl default_hard_opt: -dnl __(vpush1(imm5)) -dnl __(vpush1(imm5)) -dnl __(bne cr1,default_hard_opt_loop) -dnl rest_keys: -dnl __(cmpri(cr0,arg_reg,nil_value)) -dnl __(bne cr5,have_rest) -dnl __(bne cr4,have_keys) -dnl __(bne cr0,toomany) -dnl __(bx lr) -dnl have_rest: -dnl __(vpush1(arg_reg)) -dnl __(beqlr cr4) -dnl have_keys: -dnl /* Ensure that arg_reg contains a proper,even-length list. */ -dnl /* Insist that its length is <= 512 (as a cheap circularity check.) */ -dnl __(mov imm0,#256) -dnl __(mov arg_x,arg_reg) -dnl count_keys_loop: -dnl __(extract_lisptag(imm3,arg_x)) -dnl __(cmpri(cr3,imm3,tag_list)) -dnl __(cmpri(cr0,arg_x,nil_value)) -dnl __(subi imm0,imm0,1) -dnl __(cmpri(cr4,imm0,0)) -dnl __(beq cr0,counted_keys) -dnl __(bne cr3,badlist) -dnl __(ldr arg_x,[arg_x,#cons.cdr]) -dnl __(extract_lisptag(imm3,arg_x)) -dnl __(cmpri(cr3,imm3,tag_list)) -dnl __(blt cr4,toomany) -dnl __(cmpri(cr0,arg_x,nil_value)) -dnl __(beq cr0,db_badkeys) -dnl __(bne cr3,badlist) -dnl __(ldr arg_x,[arg_x,#cons.cdr]) -dnl __(b count_keys_loop) -dnl counted_keys: -dnl /* We've got a proper, even-length list of key/value pairs in */ -dnl /* arg_reg. For each keyword var in the lambda-list, push a pair */ -dnl /* of NILs on the vstack. */ -dnl __(extrwi. imm0,nargs,mask_key_width,mask_key_start ) -dnl __(mov imm2,imm0) /* save number of keys */ -dnl __(mov imm5,#nil_value) -dnl __(b push_pair_test) -dnl push_pair_loop: -dnl __(cmpri(cr0,imm0,1)) -dnl __(subi imm0,imm0,1) -dnl __(vpush1(imm5)) -dnl __(vpush1(imm5)) -dnl push_pair_test: -dnl __(bne cr0,push_pair_loop) -dnl __(slwi imm2,imm2,dnode_shift) /* pairs -> bytes */ -dnl __(add imm2,vsp,imm2) /* imm2 points below pairs */ -dnl __(mov imm0,#0) /* count unknown keywords so far */ -dnl __(extrwi imm1,nargs,1,mask_aok) /* unknown keywords allowed */ -dnl __(extrwi nargs,nargs,mask_key_width,mask_key_start) -dnl /* Now, for each keyword/value pair in the list */ -dnl /* a) if the keyword is found in the keyword vector, set the */ -dnl /* corresponding entry on the vstack to the value and the */ -dnl /* associated supplied-p var to T. */ -dnl /* b) Regardless of whether or not the keyword is found, */ -dnl /* if :ALLOW-OTHER-KEYS is provided with a non-nil value, */ -dnl /* set the low bit of imm1 to indicate that unknown keywords */ -dnl /* are acceptable. (This bit is pre-set above to the value */ -dnl /* the encoded value of &allow_other_keys.) */ -dnl /* c) If the keyword is not found (and isn't :ALLOW-OTHER-KEYS), increment */ -dnl /* the count of unknown keywords in the high bits of imm1*/ -dnl /* At the end of the list, signal an error if any unknown keywords were seen */ -dnl /* but not allowed. Otherwise, return. */ -dnl -dnl match_keys_loop: -dnl __(cmpri(cr0,arg_reg,nil_value)) -dnl __(mov imm0,#0) -dnl __(mov imm3,#misc_data_offset) -dnl __(beq cr0,matched_keys) -dnl __(ldr arg_x,[arg_reg,#cons.car]) -dnl __(mov arg_y,#nrs.kallowotherkeys) -dnl __(cmpr(cr3,arg_x,arg_y)) /* :ALLOW-OTHER-KEYS ? */ -dnl __(ldr arg_reg,[arg_reg,#cons.cdr]) -dnl __(ldr arg_y,[arg_reg,#cons.car]) -dnl __(cmpr(cr4,imm0,nargs)) -dnl __(ldr arg_reg,[arg_reg,#cons.cdr]) -dnl __(b match_test) -dnl match_loop: -dnl __(ldrx(temp0,keyvect_reg,imm3)) -dnl __(cmpr(cr0,arg_x,temp0)) -dnl __(addi imm0,imm0,1) -dnl __(cmpr(cr4,imm0,nargs)) -dnl __(addi imm3,imm3,node_size) -dnl __(bne cr0,match_test) -dnl /* Got a hit. Unless this keyword's been seen already, set it. */ -dnl __(slwi imm0,imm0,dnode_shift) -dnl __(subf imm0,imm0,imm2) -dnl __(ldr temp0,[imm0,#0]) -dnl __(cmpri(cr0,temp0,nil_value)) -dnl __(mov temp0,#t_value) -dnl __(bne cr0,match_keys_loop) /* already saw this */ -dnl __(str(arg_y,node_size*1(imm0))) -dnl __(str(temp0,node_size*0(imm0))) -dnl __(bne cr3,match_keys_loop) -dnl __(b match_keys_check_aok) -dnl match_test: -dnl __(bne cr4,match_loop) -dnl __(beq cr3,match_keys_check_aok) -dnl __(addi imm1,imm1,node_size) -dnl __(b match_keys_loop) -dnl match_keys_check_aok: -dnl __(andi. imm0,imm1,2) /* check "seen-aok" bit in imm1 */ -dnl __(cmpri cr1,arg_y,nil_value) /* check value */ -dnl __(ori imm1,imm1,2) -dnl __(bne cr0,match_keys_loop) /* duplicate aok */ -dnl __(beq cr1,match_keys_loop) -dnl __(ori imm1,imm1,1) -dnl __(b match_keys_loop) -dnl matched_keys: -dnl __(clrrwi. imm0,imm1,2) -dnl __(beqlr) -dnl __(andi. imm1,imm1,1) -dnl __(bnelr) -dnl /* Some unrecognized keywords. Complain generically about */ -dnl /* invalid keywords. */ -dnl db_badkeys: -dnl __(mov arg_y,#XBADKEYS) -dnl __(b destructure_error) -dnl toomany: -dnl __(mov arg_y,#XCALLTOOMANY) -dnl __(b destructure_error) -dnl toofew: -dnl __(mov arg_y,#XCALLTOOFEW) -dnl __(b destructure_error) -dnl badlist: -dnl __(mov arg_y,#XCALLNOMATCH) -dnl /* b destructure_error */ -dnl destructure_error: -dnl __(mov vsp,imm4) /* undo everything done to the stack */ -dnl __(mov arg_z,whole_reg) -dnl __(set_nargs(2)) -dnl __(b _SPksignalerr) -dnl + + +/* Destructuring-bind, macro-bind. */ + +/* OK to use arg_x, arg_y for whatever (tagged) purpose; */ +/* likewise immX regs. */ +/* arg_z preserved, nothing else in particular defined on exit. */ +/* nargs contains req count (0-255) in PPC bits mask_req_start/mask_req_width, */ +/* opt count (0-255) in PPC bits mask_opt_start/mask_opt_width, */ +/* key count (0-255) in PPC bits mask_key_start/mask_key_width, */ +/* opt-supplied-p flag in PPC bit mask_initopt, */ +/* keyp flag in PPC bit mask_keyp, */ +/* &allow-other-keys flag in PPC bit mask_aok, */ +/* &rest flag in PPC bit mask_restp. */ +/* When mask_keyp bit is set, keyvect contains vector of keyword symbols, */ +/* length key count. */ + +_spentry(macro_bind) + __(mov whole_reg,arg_reg) + __(extract_lisptag(imm0,arg_reg)) + __(cmp imm0,#tag_list) + __(bne 1f) + __(_cdr(arg_reg,arg_reg)) + __(b C(destbind1)) +1: + __(mov arg_y,#XCALLNOMATCH) + __(mov arg_z,whole_reg) + __(set_nargs(2)) + __(b _SPksignalerr) + +_spentry(destructuring_bind) + __(mov whole_reg,arg_reg) + __(b C(destbind1)) + +_spentry(destructuring_bind_inner) + __(mov whole_reg,arg_z) + __(b C(destbind1)) + dnl /* vpush the values in the value set atop the vsp, incrementing nargs. */ dnl /* Discard the tsp frame; leave values atop the vsp. */ @@ -2257,9 +2091,9 @@ dnl local_label(walkloop): dnl __(ldr imm3,[imm1,#tsp_frame.fixed_overhead+node_size]) /* next segment */ -dnl __(cmpr(cr0,imm0,imm3)) /* last segment? */ +dnl __(cmpr(imm0,imm3)) /* last segment? */ dnl __(str(imm2,tsp_frame.fixed_overhead+node_size(imm1))) /* reverse pointer */ dnl __(mov imm2,imm1) /* last segment <- current segment */ dnl __(mov imm1,imm3) /* current segment <- next segment */ -dnl __(bne cr0,local_label(walkloop)) +dnl __(bne local_label(walkloop)) dnl dnl /* the final segment ptr is now in imm2 */ @@ -2267,5 +2101,5 @@ dnl local_label(pushloop): dnl __(ldr imm0,[imm2,#tsp_frame.data_offset]) /* nargs in segment */ -dnl __(cmpri(cr0,imm0,0)) +dnl __(cmpri(imm0,0)) dnl __(cmpr(cr1,imm2,tsp)) dnl __(la imm3,tsp_frame.data_offset+(2*node_size)(imm2)) @@ -2275,9 +2109,9 @@ dnl 1: dnl __(ldru(arg_z,-node_size(imm3))) -dnl __(cmpri(cr0,imm0,fixnum_one)) +dnl __(cmpri(imm0,fixnum_one)) dnl __(subi imm0,imm0,fixnum_one) dnl __(vpush1(arg_z)) dnl 2: -dnl __(bne cr0,1b) +dnl __(bne 1b) dnl __(ldr imm2,[imm2,#tsp_frame.data_offset+node_size]) /* previous segment */ dnl __(bne cr1,local_label(pushloop)) @@ -2343,5 +2177,5 @@ dnl __(cmpri(cr4,imm0,2< bytes */ +dnl __(add imm2,vsp,imm2) /* imm2 points below pairs */ +dnl __(mov imm0,#0) /* count unknown keywords so far */ +dnl __(extrwi imm1,nargs,1,mask_aok) /* unknown keywords allowed */ +dnl __(extrwi nargs,nargs,mask_key_width,mask_key_start) +dnl /* Now, for each keyword/value pair in the list */ +dnl /* a) if the keyword is found in the keyword vector, set the */ +dnl /* corresponding entry on the vstack to the value and the */ +dnl /* associated supplied-p var to T. */ +dnl /* b) Regardless of whether or not the keyword is found, */ +dnl /* if :ALLOW-OTHER-KEYS is provided with a non-nil value, */ +dnl /* set the low bit of imm1 to indicate that unknown keywords */ +dnl /* are acceptable. (This bit is pre-set above to the value */ +dnl /* the encoded value of &allow_other_keys.) */ +dnl /* c) If the keyword is not found (and isn't :ALLOW-OTHER-KEYS), increment */ +dnl /* the count of unknown keywords in the high bits of imm1*/ +dnl /* At the end of the list, signal an error if any unknown keywords were seen */ +dnl /* but not allowed. Otherwise, return. */ +dnl +dnl match_keys_loop: +dnl __(cmpri(arg_reg,nil_value)) +dnl __(mov imm0,#0) +dnl __(mov imm3,#misc_data_offset) +dnl __(beq matched_keys) +dnl __(ldr arg_x,[arg_reg,#cons.car]) +dnl __(mov arg_y,#nrs.kallowotherkeys) +dnl __(cmpr(cr3,arg_x,arg_y)) /* :ALLOW-OTHER-KEYS ? */ +dnl __(ldr arg_reg,[arg_reg,#cons.cdr]) +dnl __(ldr arg_y,[arg_reg,#cons.car]) +dnl __(cmpr(cr4,imm0,nargs)) +dnl __(ldr arg_reg,[arg_reg,#cons.cdr]) +dnl __(b match_test) +dnl match_loop: +dnl __(ldrx(temp0,keyvect_reg,imm3)) +dnl __(cmpr(arg_x,temp0)) +dnl __(addi imm0,imm0,1) +dnl __(cmpr(cr4,imm0,nargs)) +dnl __(addi imm3,imm3,node_size) +dnl __(bne match_test) +dnl /* Got a hit. Unless this keyword's been seen already, set it. */ +dnl __(slwi imm0,imm0,dnode_shift) +dnl __(subf imm0,imm0,imm2) +dnl __(ldr temp0,[imm0,#0]) +dnl __(cmpri(temp0,nil_value)) +dnl __(mov temp0,#t_value) +dnl __(bne match_keys_loop) /* already saw this */ +dnl __(str(arg_y,node_size*1(imm0))) +dnl __(str(temp0,node_size*0(imm0))) +dnl __(bne cr3,match_keys_loop) +dnl __(b match_keys_check_aok) +dnl match_test: +dnl __(bne cr4,match_loop) +dnl __(beq cr3,match_keys_check_aok) +dnl __(addi imm1,imm1,node_size) +dnl __(b match_keys_loop) +dnl match_keys_check_aok: +dnl __(andi. imm0,imm1,2) /* check "seen-aok" bit in imm1 */ +dnl __(cmpri cr1,arg_y,nil_value) /* check value */ +dnl __(ori imm1,imm1,2) +dnl __(bne match_keys_loop) /* duplicate aok */ +dnl __(beq cr1,match_keys_loop) +dnl __(ori imm1,imm1,1) +dnl __(b match_keys_loop) +dnl matched_keys: +dnl __(clrrwi. imm0,imm1,2) +dnl __(beqlr) +dnl __(andi. imm1,imm1,1) +dnl __(bnelr) +dnl /* Some unrecognized keywords. Complain generically about */ +dnl /* invalid keywords. */ +dnl db_badkeys: +dnl __(mov arg_y,#XBADKEYS) +dnl __(b destructure_error) +dnl toomany: +dnl __(mov arg_y,#XCALLTOOMANY) +dnl __(b destructure_error) +dnl toofew: +dnl __(mov arg_y,#XCALLTOOFEW) +dnl __(b destructure_error) +dnl badlist: +dnl __(mov arg_y,#XCALLNOMATCH) +dnl /* b destructure_error */ +dnl destructure_error: +dnl __(mov vsp,imm4) /* undo everything done to the stack */ +dnl __(mov arg_z,whole_reg) +dnl __(set_nargs(2)) +dnl __(b _SPksignalerr) + +/* imm2: (tstack-consed) target catch frame, imm0: count of intervening */ +/* frames. If target isn't a multiple-value receiver, discard extra values */ +/* (less hair, maybe.) */ +C(_throw_found): +pushdef(`__',` + .word 0 + ') + __(ldr imm1,[imm2,#catch_frame.mvflag]) + __(cmpri(imm1,0)) + __(cmpri(cr1,nargs,0)) + __(mov fn,#0) + __(add imm1,vsp,nargs) + __(add imm1,[imm1,#-node_size]) + __(bne local_label(_throw_all_values)) + __(set_nargs(1)) + __(beq cr1,local_label(_throw_default_1_val)) + __(mov vsp,imm1) + __(b local_label(_throw_all_values)) +local_label(_throw_default_1_val): + __(mov imm4,#nil_value) + __(vpush1(imm4)) +local_label(_throw_all_values): + __(bl _SPnthrowvalues) + __(ldr imm3,[rcontext,#tcr.catch_top]) + __(ldr imm1,[rcontext,#tcr.db_link]) + __(ldr imm0,[imm3,#catch_frame.db_link]) + __(ldr imm4,[imm3,#catch_frame.mvflag]) + __(cmpr(imm0,imm1)) + __(cmpri(cr1,imm4,0)) + __(add tsp,[imm3,#-((tsp_frame.fixed_overhead+fulltag_misc))]) + __(beq local_label(_throw_dont_unbind)) + __(bl _SPunbind_to) +local_label(_throw_dont_unbind): + __(add imm0,vsp,nargs) + __(cmpri(nargs,0)) + __(ldr imm1,[imm3,#catch_frame.csp]) + __(ldr imm1,[imm1,#lisp_frame.savevsp]) + __(bne cr1,local_label(_throw_multiple)) + /* Catcher expects single value in arg_z */ + __(ldr arg_z,[imm0,#-node_size]) + __(b local_label(_throw_pushed_values)) +local_label(_throw_multiple): + __(beq local_label(_throw_pushed_values)) + __(mov imm2,nargs) +local_label(_throw_mvloop): + __(sub imm2,imm2,fixnum_one) + __(cmpri(imm2,0)) + __(ldru(temp0,-node_size(imm0))) + __(push(temp0,imm1)) + __(bgt local_label(_throw_mvloop)) +local_label(_throw_pushed_values): + __(mov vsp,imm1) + __(ldr imm1,[imm3,#catch_frame.xframe]) + __(str(imm1,tcr.xframe(rcontext))) + __(ldr sp,[imm3,#catch_frame.csp]) + __(ldr fn,[sp,#lisp_frame.savefn]) + __(ldr loc_pc,[sp,#lisp_frame.savelr]) + __(discard_lisp_frame()) + __(mtlr loc_pc) + __(restore_catch_nvrs(imm3)) + __(ldr imm3,[imm3,#catch_frame.link]) + __(str(imm3,tcr.catch_top(rcontext))) + __(unlink(tsp)) + __(bx lr) +popdef(`__') + +C(nthrow1v): +local_label(_nthrow1v_nextframe): + __(subs temp2,temp2,#fixnum_one) + __(ldr temp0,[rcontext,#tcr.catch_top]) + __(ldr imm1,[rcontext,#tcr.db_link]) + __(set_nargs(1)) + __(blt local_label(_nthrow1v_done)) + __(ldr arg_y,[temp0,#catch_frame.link]) + __(ldr imm0,[temp0,#catch_frame.db_link]) + __(cmp imm0,imm1) + __(str arg_y,[rcontext,#tcr.catch_top]) + __(ldr arg_y,[temp0,#catch_frame.xframe]) + __(str arg_y,[rcontext,#tcr.xframe]) + __(beq local_label(_nthrow1v_dont_unbind)) + __(do_unbind_to(imm0,temp1,arg_x,arg_y)) +local_label(_nthrow1v_dont_unbind): + __(ldr temp1,[temp0,#catch_frame.catch_tag]) + __(cmp temp1,#unbound_marker) /* unwind-protect ? */ + __(beq local_label(_nthrow1v_do_unwind)) + /* A catch frame. If the last one, restore context from there. */ + __(cmp temp2,#0) + __(ldreq vsp,[sp,#lisp_frame.savevsp]) + __(add sp,sp,#catch_frame.size+lisp_frame.size) + __(b local_label(_nthrow1v_nextframe)) +local_label(_nthrow1v_do_unwind): +pushdef(`__',` + .word 0 + ') + /* This is harder, but not as hard (not as much BLTing) as the */ + /* multiple-value case. */ + /* Save our caller's LR and FN in the csp frame created by the unwind- */ + /* protect. (Clever, eh ?) */ + + __(la tsp,-(tsp_frame.fixed_overhead+fulltag_misc)(temp0)) + __(unlink(tsp)) + __(ldr loc_pc,[sp,#lisp_frame.savelr]) + __(ldr nfn,[sp,#lisp_frame.savefn]) + __(mtctr loc_pc) /* cleanup code address. */ + __(str(fn,lisp_frame.savefn(sp))) + __(mflr loc_pc) + __(mov fn,nfn) + __(str(loc_pc,lisp_frame.savelr(sp))) + __(TSP_Alloc_Fixed_Boxed(2*node_size)) /* tsp overhead, value, throw count */ + __(str(arg_z,tsp_frame.data_offset(tsp))) + __(str(temp2,tsp_frame.data_offset+node_size(tsp))) + __(ldr vsp,[sp,#lisp_frame.savevsp]) + __(str(rzero,tcr.unwinding(rcontext))) + __(bctrl) + __(mov imm1,#1) + __(ldr arg_z,[tsp,#tsp_frame.data_offset]) + __(str(imm1,tcr.unwinding(rcontext))) + __(ldr temp2,[tsp,#tsp_frame.data_offset+node_size]) + __(ldr fn,[sp,#lisp_frame.savefn]) + __(ldr loc_pc,[sp,#lisp_frame.savelr]) + __(discard_lisp_frame()) + __(mtlr loc_pc) + __(unlink(tsp)) + __(b local_label(_nthrow1v_nextframe)) +popdef(`__') +local_label(_nthrow1v_done): + __(mov imm0,#0) + __(str imm0,[rcontext,#tcr.unwinding]) + /* nargs has an undefined value here, so we can clobber it while */ + /* polling for a deferred interrupt */ + __(check_pending_interrupt(nargs)) + __(bx lr) + + _endfile Index: /branches/arm/lisp-kernel/arm-uuo.s =================================================================== --- /branches/arm/lisp-kernel/arm-uuo.s (revision 13686) +++ /branches/arm/lisp-kernel/arm-uuo.s (revision 13687) @@ -83,4 +83,5 @@ define(`uuo_error_not_callable',`unaryUUO($1,$2,2)') define(`uuo_tlb_too_small',`unaryUUO($1,$2,4)') +define(`uuo_error_no_throw_tag',`unaryUUO($1,$2,5)') /* Binary UUOs */