source: branches/arm/lisp-kernel/arm-spentry.s @ 13687

Last change on this file since 13687 was 13687, checked in by gb, 10 years ago

More stuff!

File size: 140.5 KB
Line 
1/* Copyright (C) 2010 Clozure Associates */
2/* This file is part of Clozure CL.   */
3
4/* Clozure CL is licensed under the terms of the Lisp Lesser GNU Public */
5/* License , known as the LLGPL and distributed with Clozure CL as the */
6/* file "LICENSE".  The LLGPL consists of a preamble and the LGPL, */
7/* which is distributed with Clozure CL as the file "LGPL".  Where these */
8/* conflict, the preamble takes precedence.   */
9
10/* Clozure CL is referenced in the preamble as the "LIBRARY." */
11
12/* The LLGPL is also available online at */
13/* http://opensource.franz.com/preamble.html */
14
15
16
17        include(lisp.s)
18        _beginfile
19        .align 2
20        .arm
21        .syntax unified
22
23local_label(start):
24        .set sporg,0       
25define(`_spentry',`ifdef(`__func_name',`_endfn',`')
26        .org sporg
27        _exportfn(_SP$1)
28        .set sporg,sporg+256       
29        .line  __line__
30')
31
32
33define(`_endsubp',`
34        _endfn(_SP$1)
35# __line__
36')
37
38
39       
40
41define(`jump_builtin',`
42        ref_nrs_value(fname,builtin_functions)
43        set_nargs($2)
44        vrefr(fname,fname,$1)
45        jump_fname()
46')
47
48_spentry(builtin_plus)
49        __(test_two_fixnums(arg_y,arg_z,imm0))
50        __(bne 1f)
51        __(adds arg_z,arg_y,arg_z)
52        __(bxvc lr)
53        __(b _SPfix_overflow)
541:
55        __(jump_builtin(_builtin_plus,2))
56       
57_spentry(builtin_minus)
58        __(test_two_fixnums(arg_y,arg_z,imm0))
59        __(bne 1f)
60        __(subs arg_z,arg_y,arg_z)
61        __(bxvc lr)
62        __(b _SPfix_overflow)
631:
64        __(jump_builtin(_builtin_minus,2))
65
66_spentry(builtin_times)
67        __(test_two_fixnums(arg_y,arg_z,imm0))
68        __(bne 1f)
69        __(unbox_fixnum(imm2,arg_z))
70        __(smull arg_z,imm1,imm2,arg_y)
71        /* Now have a "64-bit fixnum" in imm1(high) and arg_z(low). If */
72        /* imm1 is just a sign extension of arg_z, return arg_z */
73        __(cmp imm1,arg_z,asr #(nbits_in_word-1))
74        __(bxeq lr)
75        /* Need to ashift the pair imm1:imm0 right fixnumshift bits */
76        __(mov imm0,imm0,lsr #fixnumshift)
77        __(and imm2,imm1,#fixnummask)
78        __(orr imm0,imm0,imm2,lsl #(nbits_in_word-fixnumshift))
79        __(unbox_fixnum(imm1,imm1))
80        __(b _SPmakes64)
81
821: __(jump_builtin(_builtin_times,2))
83
84_spentry(builtin_div)
85        __(jump_builtin(_builtin_div,2))
86
87_spentry(builtin_eq)
88        __(test_two_fixnums(arg_y,arg_z,imm0))
89        __(bne 1f)
90        __(cmp arg_y,arg_z)
91        __(mov arg_z,#nil_value)
92        __(addeq arg_z,arg_z,#t_offset)
93        __(bx lr)       
941:
95        __(jump_builtin(_builtin_eq,2))
96                       
97_spentry(builtin_ne)
98        __(test_two_fixnums(arg_y,arg_z,imm0))
99        __(bne 1f)
100        __(cmp arg_y,arg_z)
101        __(mov arg_z,#nil_value)
102        __(addne arg_z,arg_z,#t_offset)
103        __(bx lr)
1041:
105        __(jump_builtin(_builtin_ne,2))
106
107_spentry(builtin_gt)
108        __(test_two_fixnums(arg_y,arg_z,imm0))
109        __(bne 1f)
110        __(cmp arg_y,arg_z)
111        __(mov arg_z,#nil_value)
112        __(addgt arg_z,arg_z,#t_offset)
113        __(bx lr)
1141:
115        __(jump_builtin(_builtin_gt,2))
116
117_spentry(builtin_ge)
118        __(test_two_fixnums(arg_y,arg_z,imm0))
119        __(bne 1f)
120        __(cmp arg_y,arg_z)
121        __(mov arg_z,#nil_value)
122        __(addge arg_z,arg_z,#t_offset)
123        __(bx lr)
1241:
125        __(jump_builtin(_builtin_ge,2))
126
127_spentry(builtin_lt)
128        __(test_two_fixnums(arg_y,arg_z,imm0))
129        __(bne 1f)
130        __(cmp arg_y,arg_z)
131        __(mov arg_z,#nil_value)
132        __(addgt arg_z,arg_z,#t_offset)
133        __(bx lr)
1341:
135        __(jump_builtin(_builtin_lt,2))
136
137_spentry(builtin_le)
138        __(test_two_fixnums(arg_y,arg_z,imm0))
139        __(bne 1f)
140        __(cmp arg_y,arg_z)
141        __(mov arg_z,#nil_value)
142        __(addle arg_z,arg_z,#t_offset)
143        __(bx lr)
1441:
145        __(jump_builtin(_builtin_le,2))
146
147_spentry(builtin_eql)
148        __(cmp arg_y,arg_z)
149        __(beq 1f)
150        __(extract_fulltag(imm0,arg_y))
151        __(extract_fulltag(imm1,arg_z))
152        __(cmp imm0,imm1)
153        __(bne 2f)
154        __(cmp imm0,#fulltag_misc)
155        __(bne 2f)
156        __(jump_builtin(_builtin_eql,2))
1571:      __(mov arg_z,#nil_value)
158        __(add arg_z,arg_z,#t_offset)
159        __(bx lr)
1602:      __(mov arg_z,#nil_value)
161        __(bx lr)
162       
163_spentry(builtin_length)
164        __(extract_typecode(imm0,arg_z))
165        __(cmp imm0,#min_vector_subtag)
166        __(ldreq arg_z,[arg_z,#vectorH.logsize])
167        __(bxeq lr)
168        __(blo 1f)
169        __(vector_length(arg_z,arg_z,imm0))
170        __(bx lr)
1711:      __(cmp imm0,#tag_list)
172        __(bne 8f)
173        __(mov temp2,#-1<<fixnum_shift)
174        __(mov temp0,arg_z) /* fast pointer  */
175        __(mov temp1,arg_z) /* slow pointer  */
1762:      __(cmp temp0,#nil_value)
177        __(add temp2,temp2,#fixnumone)
178        __(beq 9f)
179        __(extract_lisptag(imm0,temp0))
180        __(cmp imm0,#tag_list)
181        __(bne 8f)
182        __(_cdr(temp0,temp0))
183        __(tst temp2,#fixnumone)
184        __(beq 2b)
185        __(_cdr(temp1,temp1))
186        __(cmp temp1,temp0)
187        __(bne 2b)
1888:
189        __(jump_builtin(_builtin_length,1))
1909:      __(mov arg_z,temp2)
191        __(bx lr)       
192
193_spentry(builtin_seqtype)
194        __(extract_typecode(imm0,arg_z))
195        __(cmp imm0,#min_vector_subtag)
196        __(movge arg_z,#nil_value)
197        __(bxge lr)
198        __(cmp imm0,#tag_list)
199        __(moveq arg_z,#nil_value)
200        __(addeq arg_z,arg_z,#t_offset)
201        __(bxeq lr)
202        __(jump_builtin(_builtin_seqtype,1))
203
204/* This is usually inlined these days */
205_spentry(builtin_assq)
206        __(b 2f)
2071:      __(trap_unless_list(arg_z,imm0))
208        __(_car(arg_x,arg_z))
209        __(_cdr(arg_z,arg_z))
210        __(cmp arg_x,#nil_value)
211        __(beq 2f)
212        __(trap_unless_list(arg_x,imm0))
213        __(_car(temp0,arg_x))
214        __(cmp temp0,arg_y)
215        __(bne 2f)
216        __(mov arg_z,arg_x)
217        __(bx lr)
2182:      __(cmp arg_z,#nil_value)
219        __(bne 1b)
220        __(bx lr)
221 
222_spentry(builtin_memq)
223        __(cmp arg_z,nil_value)
224        __(b 2f)
2251:      __(trap_unless_list(arg_z,imm0))
226        __(_car(arg_x,arg_z))
227        __(_cdr(temp0,arg_z))
228        __(cmp arg_x,arg_y)
229        __(bxeq lr)
230        __(cmp temp0,nil_value)
231        __(mov arg_z,temp0)
2322:      __(bne 1b)
233        __(bx lr)
234
235_spentry(builtin_logbitp)
236/* Call out unless both fixnums,0 <=  arg_y < logbitp_max_bit  */
237        __(test_two_fixnums(arg_y,arg_z,imm0))
238        __(bne 1f)
239        __(uuo_suspend_now(al))
240        __(cmp arg_y,#(nbits_in_word-fixnumshift)<<fixnumshift)
241        __(bhs 1f)
242        __(unbox_fixnum(imm0,arg_y))
243        __(mov imm1,#fixnum1)
244        __(tst arg_z,imm1,lsl imm0)
245        __(mov arg_z,#nil_value)
246        __(addne arg_z,arg_z,#t_offset)
247        __(bx lr)
2481:
249        __(jump_builtin(_builtin_logbitp,2))
250
251_spentry(builtin_logior)
252        __(orr imm0,arg_y,arg_z)
253        __(test_fixnum(imm0))
254        __(moveq arg_z,imm0)
255        __(bxeq lr)
256        __(jump_builtin(_builtin_logior,2))
257
258_spentry(builtin_logand)
259        __(test_two_fixnums(arg_y,arg_z,imm0))
260        __(andeq arg_z,arg_y,arg_z)
261        __(bxeq lr)
262        __(jump_builtin(_builtin_logand,2))
263         
264_spentry(builtin_ash)
265        __(test_two_fixnums(arg_y,arg_z,imm0))
266        __(bne 9f)
267        __(cmp arg_z,#0)
268        __(bgt 1f)
269        __(moveq arg_z,arg_y)
270        __(bxeq lr)
271        /* Shift right */
272        __(unbox_fixnum(imm2,arg_z))
273        __(rsb imm2,imm2,#0)
274        __(cmp imm2,#32)
275        __(movge imm2,#31)
276        __(mov arg_z,#-fixnumone)
277        __(and arg_z,arg_z,arg_y,lsr imm2)
278        __(bx lr)
279        /* shift left */
2801:      __(unbox_fixnum(imm0,arg_y))
281        __(unbox_fixnum(imm2,arg_z))
282        __(cmp imm2,#32)
283        __(moveq imm1,imm0)
284        __(moveq imm0,#0)
285        __(beq _SPmakes64)
286        __(bgt 9f)
287        __(mov imm1,imm1,asl imm2)
288        __(rsb imm2,imm2,#32)
289        __(orr imm1,imm1,imm0,asr imm2)
290        __(unbox_fixnum(imm2,arg_z))
291        __(mov imm0,imm0,asl imm2)
292        __(b _SPmake64)
2939: 
294        __(jump_builtin(_builtin_ash,2))
295                                       
296_spentry(builtin_negate)
297        __(test_fixnum(arg_z))
298        __(bne 1f)
299        __(rsbs arg_z,arg_z,#0)
300        __(bxvc lr)
301        __(b _SPfix_overflow)
3021:
303        __(jump_builtin(_builtin_negate,1))
304 
305_spentry(builtin_logxor)
306        __(test_two_fixnums(arg_y,arg_z,imm0))
307        __(eoreq arg_z,arg_y,arg_z)
308        __(bxeq lr)
309        __(jump_builtin(_builtin_logxor,2))
310
311_spentry(builtin_aref1)
312        __(extract_typecode(imm0,arg_y))
313        __(cmp imm0,#min_vector_subtag)
314        __(box_fixnum(arg_x,imm0))
315        __(bgt _SPsubtag_misc_ref)
316        __(jump_builtin(_builtin_aref1,2))
317
318_spentry(builtin_aset1)
319        __(extract_typecode(imm0,arg_x))
320        __(cmp imm0,#min_vector_subtag)
321        __(box_fixnum(temp0,imm0))
322        __(bgt _SPsubtag_misc_set)
323        __(jump_builtin(_builtin_aset1,3))
324                       
325_spentry(jmpsym)
326        __(jump_fname())
327
328_spentry(jmpnfn)
329        __(jump_nfn())
330
331        /*  Call nfn if it's either a symbol or function */
332_spentry(funcall)
333        __(funcall_nfn())
334
335/* Subprims for catch, throw, unwind_protect.  */
336
337
338_spentry(mkcatch1v)
339        __(mov imm2,#0)
340        __(mkcatch())
341        __(bx lr)
342
343_spentry(mkunwind)
344        __(mov arg_z,#unbound_marker)
345        __(mov imm2,#fixnum_one)
346        __(mkcatch())
347        __(bx lr)
348
349_spentry(mkcatchmv)
350        __(mov imm2,#fixnum_one)
351        __(mkcatch())
352        __(bx lr)
353
354/* This never affects the symbol's vcell  */
355/* Non-null symbol in arg_y, new value in arg_z          */
356_spentry(bind)
357        __(ldr imm1,[arg_y,#symbol.binding_index])
358        __(ldr imm0,[rcontext,#tcr.tlb_limit])
359        __(cmp imm0,imm1)
360        __(uuo_tlb_too_small(ls,imm1))
361        __(cmp imm1,#0)
362        __(ldr imm2,[rcontext,#tcr.tlb_pointer])
363        __(ldr imm0,[rcontext,#tcr.db_link])
364        __(ldr temp1,[imm2,imm0])
365        __(beq 9f)
366        __(vpush1(temp1))
367        __(vpush1(imm1))
368        __(vpush1(imm0))
369        __(str arg_z,[imm2,imm1])
370        __(str vsp,[rcontext,#tcr.db_link])
371        __(bx lr)
3729:
373        __(mov arg_z,arg_y)
374        __(mov arg_y,#XSYMNOBIND)
375        __(set_nargs(2))
376        __(b _SPksignalerr)
377
378_spentry(conslist)
379        __(mov arg_z,#nil_value)
380        __(cmp nargs,#0)
381        __(b 2f)
3821:
383        __(vpop1(arg_y))
384        __(Cons(arg_z,arg_z,arg_z))
385        __(subs nargs,nargs,#fixnum_one)
3862:
387        __(bne 1b)
388        __(bx lr)
389
390/* do list*: last arg in arg_z, all others vpushed, nargs set to #args vpushed.  */
391/* Cons, one cons cell at at time.  Maybe optimize this later.  */
392
393_spentry(conslist_star)
394        __(cmp nargs,#0)
395        __(b 2f)
3961:
397        __(vpop1(arg_y))
398        __(Cons(arg_z,arg_y,arg_z))
399        __(subs nargs,nargs,fixnum_one)
4002:
401        __(bne 1b)
402        __(bx lr)
403
404_spentry(makes32)
405        __(adds imm1,imm0,imm0)
406        __(addsvc arg_z,imm1,imm1)
407        __(bxvc lr)
408        __(movc16(imm1,one_digit_bignum_header))
409        __(Misc_Alloc_Fixed(arg_z,imm1,aligned_bignum_size(1)))
410        __(str imm0,[arg_z,#misc_data_offset])
411        __(bx lr)
412
413/* Construct a lisp integer out of the 32-bit unsigned value in imm0 */
414
415
416_spentry(makeu32)
417        __(tst imm0,#0xe0000000)
418        __(box_fixnum(arg_z,imm0))
419        __(bxeq lr)
420        __(tst imm0,#0x80000000)
421        __(bne 2f)
422        __(movc16(imm1,one_digit_bignum_header))
423        __(Misc_Alloc_Fixed(arg_z,imm1,aligned_bignum_size(1)))
424        __(str imm0,[arg_z,#misc_data_offset])
425        __(bx lr)
4262:             
427        __(movc16(imm1,two_digit_bignum_header))
428        __(Misc_Alloc_Fixed(arg_z,imm1,aligned_bignum_size(2)))
429        __(str imm0,[arg_z,#misc_data_offset])
430        __(bx lr)
431
432
433/* arg_z has overflowed (by one bit) as the result of an addition or
434   subtraction. */
435/* Make a bignum out of it. */
436
437_spentry(fix_overflow)
438        __(unbox_fixnum(imm0,arg_z))
439        __(eor imm0,imm0,#0xc0000000)
440        __(b _SPmakes32)
441
442
443
444/*  Construct a lisp integer out of the 64-bit unsigned value in */
445/*           imm0 (low 32 bits) and imm1 (high 32 bits) */
446       
447_spentry(makeu64)
448        __(cmp imm1,#0)
449        __(beq _SPmakeu32)
450        __(blt 3f)
451        __(movc16(imm2,two_digit_bignum_header))
452        __(Misc_Alloc_Fixed(arg_z,imm2,aligned_bignum_size(2)))
453        __(str imm0,[arg_z,#misc_data_offset])
454        __(str imm1,[arg_z,#misc_data_offset+4])
455        __(bx lr)
4563:             
457        __(movc16(imm2,three_digit_bignum_header))
458        __(Misc_Alloc_Fixed(arg_z,imm2,aligned_bignum_size(3)))
459        __(str imm0,[arg_z,#misc_data_offset])
460        __(str imm1,[arg_z,#misc_data_offset+4])
461        __(bx lr)
462
463/*  Construct a lisp integer out of the 64-bit signed value in */
464/*        imm0 (low 32 bits) and imm1 (high 32 bits). */
465_spentry(makes64)
466        __(cmp imm1,imm0,asr #31) /* is imm1 sign extension of imm0 ? */
467        __(beq _SPmakes32)        /* forget imm1 if so */
468        __(movc16(imm2,two_digit_bignum_header))
469        __(Misc_Alloc_Fixed(arg_z,imm2,aligned_bignum_size(2)))
470        __(str imm0,[arg_z,#misc_data_offset])
471        __(str imm1,[arg_z,#misc_data_offset+4])
472        __(bx lr)
473
474
475
476
477
478
479/* funcall nfn, returning multiple values if it does.  */
480_spentry(mvpass)
481        __(subs imm0,nargs,#node_size*nargregs)
482        __(movge imm0,#0)
483        __(add imm0,vsp,imm0)
484        __(build_lisp_frame(temp1,imm0))
485        __(adr lr,C(ret1valn))
486        __(mov fn,#0)
487        __(funcall_nfn())
488
489/* ret1valn returns "1 multiple value" when a called function does not  */
490/* return multiple values.  Its presence on the stack (as a return address)  */
491/* identifies the stack frame to code which returns multiple values.  */
492
493_exportfn(C(ret1valn))
494        __(restore_lisp_frame(imm0))
495        __(vpush1(arg_z))
496        __(set_nargs(1))
497        __(bx lr)
498
499/* Come here to return multiple values when  */
500/* the caller's context isn't saved in a lisp_frame.  */
501/* lr, fn valid; temp0 = entry vsp  */
502
503_spentry(values)
504local_label(return_values): 
505        __(ref_global(imm0,ret1val_addr))
506        __(mov arg_z,#nil_value)
507        __(cmp imm0,lr)
508        __(beq 3f)
509        __(cmp nargs,#fixnum_one)
510        __(add imm0,nargs,vsp)
511        __(ldrge arg_z,[imm0,#-node_size])
512        __(mov vsp,temp0)
513        __(bx lr)
514
515
516/* Return multiple values to real caller.  */
5173:
518        __(ldr lr,[sp,#lisp_frame.savelr])
519        __(add imm1,nargs,vsp)
520        __(ldr imm0,[sp,#lisp_frame.savevsp])
521        __(ldr fn,[sp,#lisp_frame.savefn])
522        __(cmp imm1,imm0) /* a fairly common case  */
523        __(discard_lisp_frame())
524        __(bxeq lr) /* already in the right place  */
525        __(cmp nargs,#fixnum_one) /* sadly, a very common case  */
526        __(bne 4f)
527        __(ldr arg_z,[vsp,#0])
528        __(mov vsp,imm0)
529        __(vpush1(arg_z))
530        __(bx lr)
5314:
532        __(blt 6f)
533        __(mov temp1,#fixnum_one)
5345:
535        __(cmp temp1,nargs)
536        __(add temp1,temp1,#fixnum_one)
537        __(ldr arg_z,[imm1,#-node_size]!)
538        __(push1(imm0,arg_z))
539        __(bne 5b)
5406:
541        __(mov vsp,imm0)
542        __(bx lr)
543
544
545/* Come here with saved context on top of stack.  */
546_spentry(nvalret)
547        .globl C(nvalret)
548C(nvalret):
549        __(ldr lr,[sp,#lisp_frame.savelr])
550        __(ldr temp0,[sp,#lisp_frame.savevsp])
551        __(ldr fn,[sp,#lisp_frame.savefn])
552        __(discard_lisp_frame())
553        __(b local_label(return_values))                         
554
555/* Caller has pushed tag and 0 or more values; nargs = nvalues.  */
556/* Otherwise, process unwind-protects and throw to indicated catch frame.  */
557
558               
559 _spentry(throw)
560        __(ldr imm1,[rcontext, #tcr.catch_top])
561        __(mov imm0,#0) /* count intervening catch/unwind-protect frames.  */
562        __(cmp imm1,#0)
563        __(ldr temp0,[vsp,nargs])
564        __(beq local_label(_throw_tag_not_found))
565local_label(_throw_loop):
566        __(ldr temp1,[imm1,#catch_frame.catch_tag])
567        __(cmp temp0,temp1)
568        __(mov imm2,imm1)
569        __(ldr imm1,[imm1,#catch_frame.link])
570        __(beq C(_throw_found))
571        __(cmp imm1,#0)
572        __(add imm0,imm0,#fixnum_one)
573        __(bne local_label(_throw_loop))
574local_label(_throw_tag_not_found):
575        __(uuo_error_no_throw_tag(al,temp0))
576        __(str temp0,[vsp,nargs])
577        __(b _SPthrow)
578
579/* This takes N multiple values atop the vstack.  */
580_spentry(nthrowvalues)
581dnl         __(mov imm1,#1)
582dnl  __(mov imm4,imm0)
583dnl         __(str(imm1,tcr.unwinding(rcontext)))
584dnl local_label(_nthrowv_nextframe):
585dnl  __(subi imm4,imm4,fixnum_one)
586dnl  __(cmpri(cr1,imm4,0))
587dnl  __(ldr temp0,[rcontext,#tcr.catch_top])
588dnl  __(ldr imm1,[rcontext,#tcr.db_link])
589dnl  __(blt cr1,local_label(_nthrowv_done))
590dnl  __(ldr imm0,[temp0,#catch_frame.db_link])
591dnl  __(ldr imm3,[temp0,#catch_frame.link])
592dnl  __(cmpr(imm0,imm1))
593dnl  __(str(imm3,tcr.catch_top(rcontext)))
594dnl  __(ldr temp1,[temp0,#catch_frame.catch_tag])
595dnl  __(cmpri(cr7,temp1,unbound_marker))  /* unwind-protect ?  */
596dnl  __(ldr first_nvr,[temp0,#catch_frame.xframe])
597dnl  __(str(first_nvr,tcr.xframe(rcontext)))
598dnl  __(ldr sp,[temp0,#catch_frame.csp])
599dnl  __(beq local_label(_nthrowv_dont_unbind))
600dnl  __(mflr loc_pc)
601dnl         __(bl _SPunbind_to)
602dnl  __(mtlr loc_pc)
603dnl local_label(_nthrowv_dont_unbind):
604dnl  __(beq cr7,local_label(_nthrowv_do_unwind))
605dnl /* A catch frame.  If the last one, restore context from there.  */
606dnl  __(bne cr1,local_label(_nthrowv_skip))
607dnl  __(ldr imm0,[sp,#lisp_frame.savevsp])
608dnl  __(str(rzero,lisp_frame.savevsp(sp))) /* marker for stack overflow code  */
609dnl  __(add imm1,vsp,nargs)
610dnl  __(mov imm2,nargs)
611dnl  __(b local_label(_nthrowv_push_test))
612dnl local_label(_nthrowv_push_loop):
613dnl  __(ldru(temp1,-node_size(imm1)))
614dnl  __(push(temp1,imm0))
615dnl local_label(_nthrowv_push_test):
616dnl  __(cmp imm2,#0))
617dnl  __(subi imm2,imm2,fixnum_one)
618dnl  __(bne local_label(_nthrowv_push_loop))
619dnl  __(mov vsp,imm0)
620dnl         __(restore_catch_nvrs(temp0))
621dnl
622dnl local_label(_nthrowv_skip):
623dnl  __(la tsp,-(tsp_frame.fixed_overhead+fulltag_misc)(temp0))
624dnl  __(unlink(tsp))
625dnl  __(discard_lisp_frame())
626dnl  __(b local_label(_nthrowv_nextframe))
627dnl local_label(_nthrowv_do_unwind):
628dnl         /* This is harder.  Call the cleanup code with the multiple */
629dnl  /* values (and nargs, which is a fixnum.)  Remember the throw count  */
630dnl         /* (also a fixnum) as well.  */
631dnl         /* Save our caller's LR and FN in the csp frame created by the unwind-  */
632dnl         /* protect.  (Clever, eh ?)  */
633dnl  __(ldr first_nvr,[temp0,#catch_frame.xframe])
634dnl  __(str(first_nvr,tcr.xframe(rcontext)))
635dnl         __(restore_catch_nvrs(temp0))
636dnl  __(la tsp,-(tsp_frame.fixed_overhead+fulltag_misc)(temp0))
637dnl  __(unlink(tsp))
638dnl  __(ldr loc_pc,[sp,#lisp_frame.savelr])
639dnl  __(ldr nfn,[sp,#lisp_frame.savefn])
640dnl  __(mtctr loc_pc) /* cleanup code address.  */
641dnl  __(str(fn,lisp_frame.savefn(sp)))
642dnl  __(mflr loc_pc)
643dnl  __(mov fn,nfn)
644dnl  __(str(loc_pc,lisp_frame.savelr(sp)))
645dnl  __(dnode_align(imm0,nargs,tsp_frame.fixed_overhead+(2*node_size))) /* tsp overhead, nargs, throw count  */
646dnl  __(TSP_Alloc_Var_Boxed_nz(imm0,imm1))
647dnl  __(mov imm2,nargs)
648dnl  __(add imm1,nargs,vsp)
649dnl  __(la imm0,tsp_frame.data_offset(tsp))
650dnl  __(str(nargs,0(imm0)))
651dnl  __(b local_label(_nthrowv_tpushtest))
652dnl local_label(_nthrowv_tpushloop):
653dnl  __(ldru(temp0,-node_size(imm1)))
654dnl  __(stru(temp0,node_size(imm0)))
655dnl  __(subi imm2,imm2,fixnum_one)
656dnl local_label(_nthrowv_tpushtest):
657dnl  __(cmp imm2,#0)
658dnl  __(bne local_label(_nthrowv_tpushloop))
659dnl  __(stru(imm4,node_size(imm0)))
660dnl  __(ldr vsp,[sp,#lisp_frame.savevsp])
661dnl         /* Interrupts should be disabled here (we're calling and returning */
662dnl         /* from the cleanup form.  Clear the tcr.unwinding flag, so that */
663dnl         /* interrupts can be taken if they're enabled in the cleanup form.  */
664dnl         __(str(rzero,tcr.unwinding(rcontext)))       
665dnl  __(bctrl)
666dnl         __(mov imm1,#1)
667dnl  __(la imm0,tsp_frame.data_offset(tsp))
668dnl         __(str(imm1,tcr.unwinding(rcontext)))
669dnl  __(ldr fn,[sp,#lisp_frame.savefn])
670dnl  __(ldr loc_pc,[sp,#lisp_frame.savelr])
671dnl  __(discard_lisp_frame())
672dnl  __(mtlr loc_pc)
673dnl  __(ldr nargs,[imm0,#0])
674dnl  __(mov imm2,nargs)
675dnl  __(b local_label(_nthrowv_tpoptest))
676dnl local_label(_nthrowv_tpoploop):
677dnl  __(ldru(temp0,node_size(imm0)))
678dnl  __(vpush1(temp0))
679dnl  __(subi imm2,imm2,fixnum_one)
680dnl local_label(_nthrowv_tpoptest):
681dnl  __(cmp imm2,#0)
682dnl  __(bne local_label(_nthrowv_tpoploop))
683dnl  __(ldr imm4,[imm0,#node_size])
684dnl  __(unlink(tsp))
685dnl  __(b local_label(_nthrowv_nextframe))
686dnl local_label(_nthrowv_done):
687dnl         __(str(rzero,tcr.unwinding(rcontext)))
688dnl         /* Poll for a deferred interrupt.  That clobbers nargs (which we've */
689dnl         /* just expended a lot of effort to preserve), so expend a little *
690dnl         /* more effort. */
691dnl         __(mov imm4,nargs)
692dnl         __(check_pending_interrupt())
693dnl         __(mov nargs,imm4)
694dnl         __(bx lr)
695
696/* This is a (slight) optimization.  When running an unwind-protect, */
697/* save the single value and the throw count in the tstack frame. */
698/* Note that this takes a single value in arg_z.  */
699_spentry(nthrow1value)
700        __(mov imm1,#1)
701        __(mov temp2,imm0)
702        __(str imm1,[rcontext,#tcr.unwinding])
703        __(b C(nthrow1v))
704
705
706/* arg_z = symbol: bind it to its current value          */
707 _spentry(bind_self)
708        __(ldr imm1,[arg_z,#symbol.binding_index])
709        __(ldr imm0,[rcontext,#tcr.tlb_limit])
710        __(cmp imm1,#0)
711        __(beq 9f)
712        __(cmp imm0,imm1)
713        __(uuo_tlb_too_small(ls,imm1))
714        __(ldr temp2,[rcontext,#tcr.tlb_pointer])
715        __(ldr imm0,[rcontext,#tcr.db_link])
716        __(ldr temp1,[temp2,imm1])
717        __(cmp temp1,#no_thread_local_binding_marker)
718        __(movne temp0,temp1)
719        __(ldreq temp0,[arg_z,#symbol.vcell])
720        __(vpush1(temp1))   /* old tlb contents */
721        __(vpush1(imm1))    /* tlb index */
722        __(vpush1(imm0))
723        __(str temp0,[temp2,imm1])
724        __(str vsp,[rcontext,#tcr.db_link])
725        __(bx lr)
7269:      __(mov arg_y,#XSYMNOBIND)
727        __(set_nargs(2))
728        __(b _SPksignalerr)
729
730/* Bind symbol in arg_z to NIL                 */
731_spentry(bind_nil)
732        __(mov arg_y,arg_z)
733        __(mov arg_z,#nil_value)
734        __(b _SPbind)
735
736/* Bind symbol in arg_z to its current value;  trap if symbol is unbound */
737_spentry(bind_self_boundp_check)
738        __(ldr imm1,[arg_z,#symbol.binding_index])
739        __(ldr imm0,[rcontext,#tcr.tlb_limit])
740        __(cmp imm1,#0)
741        __(beq 9f)
742        __(cmp imm0,imm1)
743        __(uuo_tlb_too_small(ls,imm1))
744        __(ldr temp2,[rcontext,#tcr.tlb_pointer])
745        __(ldr imm0,[rcontext,#tcr.db_link])
746        __(ldr temp1,[temp2,imm1])
747        __(cmp temp1,#no_thread_local_binding_marker)
748        __(movne temp0,temp1)
749        __(ldreq temp0,[arg_z,#symbol.vcell])
750        __(cmp temp0,#unbound_marker)
751        __(uuo_error_unbound(eq,arg_z))
752        __(vpush1(temp1))   /* old tlb contents */
753        __(vpush1(imm1))    /* tlb index */
754        __(vpush1(imm0))
755        __(str temp0,[temp2,imm1])
756        __(str vsp,[rcontext,#tcr.db_link])
757        __(bx lr)
7589:      __(mov arg_y,#XSYMNOBIND)
759        __(set_nargs(2))
760        __(b _SPksignalerr)
761
762 
763/* The function pc_luser_xp() - which is used to ensure that suspended threads */
764/* are suspended in a GC-safe way - has to treat these subprims (which  */
765/* implement the EGC write-barrier) specially.  Specifically, a store that */
766/* might introduce an intergenerational reference (a young pointer stored  */
767/* in an old object) has to "memoize" that reference by setting a bit in  */
768/* the global "refbits" bitmap. */
769/* This has to happen atomically, and has to happen atomically wrt GC. */
770/* Note that updating a word in a bitmap is itself not atomic, unless we use */
771/* interlocked loads and stores. */
772
773
774/* For RPLACA and RPLACD, things are fairly simple: regardless of where we  */
775/* are in the function, we can do the store (even if it's already been done)  */
776/* and calculate whether or not we need to set the bit out-of-line.  (Actually */
777/* setting the bit needs to be done atomically, unless we're sure that other */
778/* threads are suspended.) */
779/* We can unconditionally set the suspended thread's PC to its LR. */
780
781        .globl C(egc_write_barrier_start)
782_spentry(rplaca)
783C(egc_write_barrier_start):     
784        __(cmp arg_z,arg_y)
785        __(_rplaca(arg_y,arg_z))
786        __(bxls lr)
787        __(ref_global(temp0,ref_base))
788        __(sub imm0,arg_y,temp0)
789        __(mov imm0,imm0,lsr #dnode_shift)
790        __(ref_global(temp0,oldspace_dnode_count))
791        __(cmp imm0,temp0)
792        __(bxhs lr)
793        __(and imm2,imm0,#31)
794        __(mov imm1,#0x80000000)
795        __(mov imm1,imm1,lsr imm2)
796        __(mov imm0,imm0,lsr #bitmap_shift)
797        __(ref_global(imm2,refbits))
798        __(add imm2,imm2,imm0,lsl #word_shift)
799        __(ldr imm0,[imm2])
800        __(ands imm0,imm0,imm1)
801        __(bxne lr)
802        __(build_lisp_frame(imm0))
803        __(set_ref_bit(rplaca))
804        __(bx lr)
805
806
807        .globl C(egc_rplacd)
808_spentry(rplacd)
809C(egc_rplacd):
810        __(cmp arg_z,arg_y)
811        __(_rplacd(arg_y,arg_z))
812        __(bxls lr)
813        __(ref_global(temp0,ref_base))
814        __(sub imm0,arg_y,temp0)
815        __(mov imm0,imm0,lsr #dnode_shift)
816        __(ref_global(temp0,oldspace_dnode_count))
817        __(cmp imm0,temp0)
818        __(bxhs lr)
819        __(and imm2,imm0,#31)
820        __(mov imm1,#0x80000000)
821        __(mov imm1,imm1,lsr imm2)
822        __(mov imm0,imm0,lsr #bitmap_shift)
823        __(ref_global(imm2,refbits))
824        __(add imm2,imm2,imm0,lsl #word_shift)
825        __(ldr imm0,[imm2])
826        __(ands imm0,imm0,imm1)
827        __(bxne lr)
828        __(build_lisp_frame(imm0))
829        __(set_ref_bit(rplacd))
830        __(bx lr)
831       
832
833/* Storing into a gvector can be handled the same way as storing into a CONS. */
834
835        .globl C(egc_gvset)
836_spentry(gvset)
837C(egc_gvset):
838        __(cmp arg_z,arg_x)
839        __(add imm0,arg_y,#misc_data_offset)
840        __(str arg_z,[arg_x,imm0])
841        __(bxls lr)
842        __(add imm0,imm0,arg_x)
843        __(ref_global(temp0,ref_base))
844        __(sub imm0,imm0,temp0)
845        __(mov imm0,imm0,lsr #dnode_shift)
846        __(ref_global(temp0,oldspace_dnode_count))
847        __(cmp imm0,temp0)
848        __(bxhs lr)
849        __(and imm2,imm0,#31)
850        __(mov imm1,#0x80000000)
851        __(mov imm1,imm1,lsr imm2)
852        __(mov imm0,imm0,lsr #bitmap_shift)
853        __(ref_global(imm2,refbits))
854        __(add imm2,imm2,imm0,lsl #word_shift)
855        __(ldr imm0,[imm2])
856        __(ands imm0,imm0,imm1)
857        __(bxne lr)
858        __(build_lisp_frame(imm0))
859        __(set_ref_bit(gvset))
860        __(bx lr)
861
862       
863dnl /* This is a special case of storing into a gvector: if we need to memoize  */
864dnl /* the store, record the address of the hash-table vector in the refmap,  */
865dnl /* as well. */
866dnl         .globl C(egc_set_hash_key)       
867dnl _spentry(set_hash_key)
868dnl C(egc_set_hash_key):
869dnl         __(cmplr(cr2,arg_z,arg_x))
870dnl         __(la imm0,misc_data_offset(arg_y))
871dnl         __(str arg_z,arg_x,imm0)
872dnl         __(blelr cr2)
873dnl         __(add imm0,imm0,arg_x)
874dnl         __(ref_global(imm2,ref_base))
875dnl         __(load_highbit(imm3))
876dnl         __(ref_global(imm1,oldspace_dnode_count))
877dnl         __(sub imm0,imm0,imm2)
878dnl         __(srri(imm0,imm0,dnode_shift))       
879dnl         __(cmplr(imm0,imm1))
880dnl         __(extract_bit_shift_count(imm4,imm0))
881dnl         __(srri(imm0,imm0,bitmap_shift))       
882dnl         __(srr(imm3,imm3,imm4))
883dnl         __(ref_global(imm2,refbits))
884dnl         __(bgelr)
885dnl         __(slri(imm0,imm0,word_shift))
886dnl         __(ldrx(imm1,imm2,imm0))
887dnl         __(and. imm1,imm1,imm3)
888dnl         __(bne 2f)       
889dnl 1:      __(lrarx(imm1,imm2,imm0))
890dnl         __(or imm1,imm1,imm3)
891dnl         __(strcx(imm1,imm2,imm0))
892dnl         __(bne- 1b)
893dnl         __(isync)
894dnl 2:             
895dnl         __(ref_global(imm1,ref_base))
896dnl         __(sub imm0,arg_x,imm1)
897dnl         __(srri(imm0,imm0,dnode_shift))
898dnl         __(load_highbit(imm3))
899dnl         __(extract_bit_shift_count(imm4,imm0))
900dnl         __(srri(imm0,imm0,bitmap_shift))
901dnl         __(srr(imm3,imm3,imm4))
902dnl         __(slri(imm0,imm0,word_shift))
903dnl         __(ldrx(imm1,imm2,imm0))
904dnl         __(and. imm1,imm1,imm3)
905dnl         __(bnelr)
906dnl 3:      __(lrarx(imm1,imm2,imm0))
907dnl         __(or imm1,imm1,imm3)
908dnl         __(strcx(imm1,imm2,imm0))
909dnl         __(bne- 3b)
910dnl         __(isync)
911dnl         __(bx lr)
912dnl         
913dnl /*
914dnl    Interrupt handling (in pc_luser_xp()) notes: 
915dnl    If we are in this function and before the test which follows the
916dnl    conditional (at egc_store_node_conditional), or at that test
917dnl    and cr0`eq' is clear, pc_luser_xp() should just let this continue
918dnl    (we either haven't done the store conditional yet, or got a
919dnl    possibly transient failure.)  If we're at that test and the
920dnl    cr0`EQ' bit is set, then the conditional store succeeded and
921dnl    we have to atomically memoize the possible intergenerational
922dnl    reference.  Note that the local labels 4 and 5 are in the
923dnl    body of the next subprim (and at or beyond 'egc_write_barrier_end').
924dnl
925dnl    N.B: it's not possible to really understand what's going on just
926dnl    by the state of the cr0`eq' bit.  A transient failure in the
927dnl    conditional stores that handle memoization might clear cr0`eq'
928dnl    without having completed the memoization.
929dnl */
930dnl
931dnl         .globl C(egc_store_node_conditional)
932dnl         .globl C(egc_write_barrier_end)
933dnl _spentry(store_node_conditional)
934dnl C(egc_store_node_conditional):
935dnl         __(cmplr(cr2,arg_z,arg_x))
936dnl         __(vpop(temp0))
937dnl         __(unbox_fixnum(imm4,temp0))
938dnl 1:      __(lrarx(temp1,arg_x,imm4))
939dnl         __(cmpr(cr1,temp1,arg_y))
940dnl         __(bne cr1,5f)
941dnl         __(strcx(arg_z,arg_x,imm4))
942dnl  .globl C(egc_store_node_conditional_test)
943dnl C(egc_store_node_conditional_test): 
944dnl         __(bne 1b)
945dnl         __(isync)
946dnl         __(add imm0,imm4,arg_x)
947dnl         __(ref_global(imm2,ref_base))
948dnl         __(ref_global(imm1,oldspace_dnode_count))
949dnl         __(sub imm0,imm0,imm2)
950dnl         __(load_highbit(imm3))
951dnl         __(srri(imm0,imm0,dnode_shift))       
952dnl         __(cmplr(imm0,imm1))
953dnl         __(extract_bit_shift_count(imm2,imm0))
954dnl         __(srri(imm0,imm0,bitmap_shift))       
955dnl         __(srr(imm3,imm3,imm2))
956dnl         __(ref_global(imm2,refbits))
957dnl         __(bge 4f)
958dnl         __(slri(imm0,imm0,word_shift))
959dnl 2:      __(lrarx(imm1,imm2,imm0))
960dnl         __(or imm1,imm1,imm3)
961dnl         __(strcx( imm1,imm2,imm0))
962dnl         __(bne- 2b)
963dnl         __(isync)
964dnl         __(b 4f)
965dnl
966dnl /* arg_z = new value, arg_y = expected old value, arg_x = hash-vector,
967dnl    vsp`0' = (boxed) byte-offset
968dnl    Interrupt-related issues are as in store_node_conditional, but
969dnl    we have to do more work to actually do the memoization.*/
970dnl _spentry(set_hash_key_conditional)
971dnl  .globl C(egc_set_hash_key_conditional)
972dnl C(egc_set_hash_key_conditional):
973dnl  __(cmplr(cr2,arg_z,arg_x))
974dnl  __(vpop(imm4))
975dnl  __(unbox_fixnum(imm4,imm4))
976dnl 1: __(lrarx(temp1,arg_x,imm4))
977dnl  __(cmpr(cr1,temp1,arg_y))
978dnl  __(bne cr1,5f)
979dnl  __(strcx(arg_z,arg_x,imm4))
980dnl  .globl C(egc_set_hash_key_conditional_test)
981dnl C(egc_set_hash_key_conditional_test):
982dnl  __(bne 1b)
983dnl  __(isync)
984dnl  __(add imm0,imm4,arg_x)
985dnl  __(ref_global(imm2,ref_base))
986dnl  __(ref_global(imm1,oldspace_dnode_count))
987dnl  __(sub imm0,imm0,imm2)
988dnl  __(load_highbit(imm3))
989dnl  __(srri(imm0,imm0,dnode_shift))
990dnl  __(cmplr(imm0,imm1))
991dnl  __(extract_bit_shift_count(imm2,imm0))
992dnl  __(srri(imm0,imm0,bitmap_shift))
993dnl  __(srr(imm3,imm3,imm2))
994dnl  __(ref_global(imm2,refbits))
995dnl  __(bge 4f)
996dnl  __(slri(imm0,imm0,word_shift))
997dnl 2: __(lrarx(imm1,imm2,imm0))
998dnl  __(or imm1,imm1,imm3)
999dnl  __(strcx(imm1,imm2,imm0))
1000dnl  __(bne- 2b)
1001dnl  __(isync)
1002dnl  /* Memoize hash table header */ 
1003dnl         __(ref_global(imm1,ref_base))
1004dnl         __(sub imm0,arg_x,imm1)
1005dnl         __(srri(imm0,imm0,dnode_shift))
1006dnl         __(load_highbit(imm3))
1007dnl         __(extract_bit_shift_count(imm4,imm0))
1008dnl         __(srri(imm0,imm0,bitmap_shift))
1009dnl         __(srr(imm3,imm3,imm4))
1010dnl         __(slri(imm0,imm0,word_shift))
1011dnl         __(ldrx(imm1,imm2,imm0))
1012dnl         __(and. imm1,imm1,imm3)
1013dnl         __(bne 4f)
1014dnl 3:      __(lrarx(imm1,imm2,imm0))
1015dnl         __(or imm1,imm1,imm3)
1016dnl         __(strcx(imm1,imm2,imm0))
1017dnl         __(bne- 3b)
1018dnl         __(isync)
1019dnl C(egc_write_barrier_end):
1020dnl 4: __(mov arg_z,#t_value)
1021dnl  __(bx lr)
1022dnl 5:      __(mov imm0,#RESERVATION_DISCHARGE)
1023dnl         __(strcx(rzero,0,imm0))
1024dnl  __(mov arg_z,#nil_value)
1025dnl  __(bx lr)
1026dnl 
1027dnl 
1028dnl         
1029dnl 
1030dnl
1031       
1032/* We always have to create a stack frame (even if nargs is 0), so the compiler  */
1033/* doesn't get confused.  */
1034_spentry(stkconslist)
1035        __(mov arg_z,#nil_value)
1036C(stkconslist_star):           
1037        __(mov temp2,nargs,lsl #1)
1038        __(add temp2,temp2,#node_size)
1039        __(mov imm0,temp2,lsl #num_subtag_bits-word_shift)
1040        __(orr imm0,imm0,#subtag_u32_vector)
1041        __(stack_allocate_zeroed_ivector(imm0,temp2))
1042        __(mov imm0,#subtag_simple_vector)
1043        __(strb imm0,[sp,#0])
1044        __(add imm1,sp,#dnode_size+fulltag_cons)
1045        __(cmp nargs,#0)
1046        __(b 4f)
10471:      __(vpop1(temp0))
1048        __(_rplaca(imm1,temp0))
1049        __(_rplacd(imm1,arg_z))
1050        __(mov arg_z,imm1)
1051        __(add imm1,imm1,#cons.size)
1052        __(subs nargs,nargs,#node_size)
10534:
1054        __(bne 1b)
1055        __(bx lr)
1056 
1057/* do list*: last arg in arg_z, all others vpushed,  */
1058/* nargs set to #args vpushed.  */
1059_spentry(stkconslist_star)
1060        __(b C(stkconslist_star))
1061
1062/* Make a stack-consed simple-vector out of the NARGS objects  */
1063/* on top of the vstack; return it in arg_z.  */
1064_spentry(mkstackv)
1065        __(dnode_align(imm1,nargs,node_size))
1066        __(mov imm0,nargs,lsl #num_subtag_bits-fixnumshift)
1067        __(orr imm0,imm0,#subtag_u32_vector)
1068        __(stack_allocate_zeroed_ivector(imm0,imm1))
1069        __(mov imm0,#subtag_simple_vector)
1070        __(strb imm0,[sp,#0])
1071        __(add arg_z,sp,#fulltag_misc)
1072        __(add imm0,arg_z,#misc_data_offset)
1073        __(add imm1,imm0,nargs)
1074        __(b 4f)
10753:      __(vpop1(arg_y))
1076        __(str arg_y,[imm1,#-node_size]!)
1077        __(sub nargs,nargs,#node_size)
10784:      __(cmp nargs,#0)
1079        __(bne 3b)
1080        __(bx lr)
1081       
1082_spentry(setqsym)
1083        __(ldr imm0,[arg_y,#symbol.flags])
1084        __(tst imm0,#sym_vbit_const_mask)
1085        __(beq _SPspecset)
1086        __(mov arg_z,arg_y)
1087        __(mov arg_y,#XCONST)
1088        __(set_nargs(2))
1089        __(b _SPksignalerr)
1090
1091
1092
1093dnl _spentry(progvsave)
1094dnl  /* Error if arg_z isn't a proper list.  That's unlikely, */
1095dnl  /* but it's better to check now than to crash later. */
1096dnl 
1097dnl  __(cmp arg_z,#nil_value)
1098dnl  __(mov arg_x,arg_z) /* fast  */
1099dnl  __(mov temp1,arg_z) /* slow  */
1100dnl  __(beq 9f)  /* Null list is proper  */
1101dnl 0:
1102dnl  __(trap_unless_list(arg_x,imm0))
1103dnl  __(_cdr(temp2,arg_x)) /* (null (cdr fast)) ?  */
1104dnl  __(cmpri(cr3,temp2,nil_value))
1105dnl  __(trap_unless_list(temp2,imm0,cr0))
1106dnl  __(_cdr(arg_x,temp2))
1107dnl  __(beq cr3,9f)
1108dnl  __(_cdr(temp1,temp1))
1109dnl  __(cmpr(arg_x,temp1))
1110dnl  __(bne 0b)
1111dnl  __(mov arg_y,#XIMPROPERLIST)
1112dnl  __(set_nargs(2))
1113dnl  __(b _SPksignalerr)
1114dnl 9: /* Whew   */
1115dnl 
1116dnl         /* Next, determine the length of arg_y.  We  */
1117dnl         /* know that it's a proper list.  */
1118dnl  __(mov imm0,#-node_size)
1119dnl  __(mov arg_x,arg_y)
1120dnl 1:
1121dnl  __(cmp arg_x,#nil_value)
1122dnl  __(la imm0,node_size(imm0))
1123dnl  __(_cdr(arg_x,arg_x))
1124dnl  __(bne 1b)
1125dnl  /* imm0 is now (boxed) triplet count.  */
1126dnl  /* Determine word count, add 1 (to align), and make room.  */
1127dnl  /* if count is 0, make an empty tsp frame and exit  */
1128dnl  __(cmp imm0,#0)
1129dnl  __(add imm1,imm0,imm0)
1130dnl  __(add imm1,imm1,imm0)
1131dnl         __(dnode_align(imm1,imm1,node_size))
1132dnl  __(bne+ 2f)
1133dnl   __(TSP_Alloc_Fixed_Boxed(2*node_size))
1134dnl   __(bx lr)
1135dnl 2:
1136dnl  __(la imm1,tsp_frame.fixed_overhead(imm1)) /* tsp header  */
1137dnl  __(TSP_Alloc_Var_Boxed_nz(imm1,imm2))
1138dnl  __(str(imm0,tsp_frame.data_offset(tsp)))
1139dnl  __(ldr imm2,[tsp,#tsp_frame.backlink])
1140dnl  __(mov arg_x,arg_y)
1141dnl  __(ldr imm1,[rcontext,#tcr.db_link])
1142dnl         __(ldr imm3,[rcontext,#tcr.tlb_limit])
1143dnl 3:
1144dnl         __(cmpri(cr1,arg_z,nil_value))
1145dnl  __(_car(temp0,arg_x))
1146dnl         __(ldr imm0,[temp0,#symbol.binding_index])
1147dnl  __(_cdr(arg_x,arg_x))
1148dnl         __(trlle(imm3,imm0))
1149dnl         __(ldr imm4,[rcontext,#tcr.tlb_pointer]) /* Need to reload after trap  */
1150dnl         __(ldrx(temp3,imm4,imm0))
1151dnl  __(cmp arg_x,#nil_value)
1152dnl         __(mov temp2,#unbound_marker)
1153dnl         __(beq cr1,4f)
1154dnl  __(_car(temp2,arg_z))
1155dnl  __(_cdr(arg_z,arg_z))
1156dnl 4:      __(push(temp3,imm2))
1157dnl  __(push(imm0,imm2))
1158dnl  __(push(imm1,imm2))
1159dnl         __(str temp2,imm4,imm0)
1160dnl  __(mov imm1,imm2)
1161dnl  __(bne 3b)
1162dnl  __(str(imm2,tcr.db_link(rcontext)))
1163dnl  __(bx lr)
1164dnl
1165dnl 
1166       
1167/* Allocate a uvector on the  stack.  (Push a frame on the stack and  */
1168/* heap-cons the object if there's no room on the stack.)  */
1169_spentry(stack_misc_alloc)
1170        __(tst arg_y,#unsigned_byte_24_mask)
1171        __(uuo_error_reg_not_xtype(ne,arg_y,xtype_unsigned_byte_24))
1172        __(unbox_fixnum(imm0,arg_z))
1173        __(extract_fulltag(imm1,imm0))
1174        __(cmp imm1,#fulltag_nodeheader)
1175        __(bne 1f)
1176        __(dnode_align(imm1,arg_y,node_size))
1177        __(cmp imm1,#stack_alloc_limit)
1178        __(bge 9f)
1179        __(mov imm0,#subtag_u32_vector)
1180        __(orr imm0,imm0,arg_y,lsl #num_subtag_bits-fixnumshift)
1181        __(stack_allocate_zeroed_ivector(imm0,imm1))
1182        __(unbox_fixnum(imm0,arg_z))
1183        __(strb imm0,[sp])
1184        __(add arg_z,sp,#fulltag_misc)
1185        __(bx lr)
11861:      __(mov imm0,arg_y,lsl #num_subtag_bits-fixnumshift)
1187        __(orr imm0,imm0,arg_z,lsr #fixnumshift)
1188        __(cmp arg_z,#max_32_bit_ivector_subtag<<fixnumshift)
1189        __(movle imm1,arg_y)
1190        __(ble 8f)
1191        __(cmp arg_z,#max_8_bit_ivector_subtag<<fixnumshift)
1192        __(movle imm1,arg_y,lsr #fixnumshift)
1193        __(ble 8f)
1194        __(cmp arg_z,#max_16_bit_ivector_subtag<<fixnumshift)
1195        __(movle imm1,arg_y,lsr #1)
1196        __(ble 8f)
1197        __(cmp arg_z,#subtag_double_float)
1198        __(moveq imm1,arg_y,lsl #1)
1199        __(addeq imm1,imm1,#node_size)
1200        __(addne imm1,arg_y,#7<<fixnumshift)
1201        __(movne imm1,imm1,lsr#3+fixnumshift)
12028:      __(dnode_align(imm1,imm1,node_size))
1203        __(cmp imm1,#stack_alloc_limit)
1204        __(bhs 9f)
1205        __(stack_allocate_zeroed_ivector(imm0,imm1))
1206        __(add arg_z,sp,#fulltag_misc)
1207        __(bx lr)
12089:
1209
1210/* Too large to safely fit on tstack.  Heap-cons the vector, but make  */
1211/* sure that there's an empty tsp frame to keep the compiler happy.  */
12120:
1213        __(movc16(imm0,make_header(1,subtag_u32_vector)))
1214        __(mov imm1,#0)
1215        __(stmdb sp!,{imm0,imm1})
1216        __(b _SPmisc_alloc)
1217
1218
1219/* subtype (boxed, of course) is vpushed, followed by nargs bytes worth of  */
1220/* initial-contents.  Note that this can be used to cons any type of initialized  */
1221/* node-header'ed misc object (symbols, closures, ...) as well as vector-like  */
1222/* objects.  */
1223
1224_spentry(gvector)
1225        __(sub nargs,nargs,#node_size)
1226        __(ldr arg_z,[vsp,nargs])
1227        __(unbox_fixnum(imm0,arg_z))
1228        __(orr imm0,imm0,nargs,lsl #num_subtag_bits-fixnum_shift)
1229        __(dnode_align(imm1,nargs,node_size))
1230        __(Misc_Alloc(arg_z,imm0,imm1))
1231        __(mov imm1,nargs)
1232        __(add imm2,imm1,#misc_data_offset)
1233        __(b 2f)
12341:
1235        __(str temp0,[arg_z,imm2])
12362:
1237        __(sub imm1,imm1,#node_size)
1238        __(cmp imm1,#0)
1239        __(sub imm2,imm2,#node_size)
1240        __(vpop1(temp0))        /* Note the intentional fencepost: */
1241                                /* discard the subtype as well.  */
1242        __(bge 1b)
1243        __(bx lr)
1244
1245_spentry(fitvals)
1246        __(subs imm0,imm0,nargs)
1247        __(mov imm1,#nil_value)
1248        __(sublt vsp,vsp,imm0)
1249        __(bxlt lr)
1250        __(b 2f)
12511:
1252        __(subs imm0,imm0,#node_size)
1253        __(vpush1(imm1))       
1254        __(add nargs,nargs,#node_size)
12552:
1256        __(bne 1b)
1257        __(bx lr)
1258
1259
1260_spentry(nthvalue)
1261        __(add imm0,vsp,nargs)
1262        __(ldr imm1,[imm0,#0])
1263        __(cmp imm1,nargs) /*  do unsigned compare:  if (n < 0) => nil.  */
1264        __(mov arg_z,#nil_value)
1265        __(rsb imm1,imm1,#0)
1266        __(sub imm1,imm1,#node_size)
1267        __(ldrlo arg_z,[imm0,imm1])
1268        __(add vsp,imm0,#node_size)
1269        __(bx lr)
1270
1271/* Provide default (NIL) values for &optional arguments; imm0 is  */
1272/* the (fixnum) upper limit on the total of required and &optional  */
1273/* arguments.  nargs is preserved, all arguments wind up on the  */
1274/* vstack.  */
1275_spentry(default_optional_args)
1276        __(vpush_argregs())
1277        __(cmp nargs,imm0)
1278        __(mov arg_z,#nil_value)
1279        __(mov imm1,nargs)
1280        __(bxhs lr)
12811:
1282        __(add imm1,imm1,#fixnum_one)
1283        __(cmp imm1,imm0)
1284        __(vpush1(arg_z))
1285        __(bne 1b)
1286        __(bx lr)
1287
1288/* Indicate whether &optional arguments were actually supplied.  nargs  */
1289/* contains the actual arg count (minus the number of required args);  */
1290/* imm0 contains the number of &optional args in the lambda list.  */
1291/* Note that nargs may be > imm0 if &rest/&key is involved.  */
1292_spentry(opt_supplied_p)
1293        __(mov imm1,#0)
1294        __(mov arg_x,#nil_value)
1295        __(add arg_x,arg_x,#t_offset)       
12961:     
1297        /* (vpush (< imm1 nargs))  */
1298        __(cmp imm1,nargs)
1299        __(subeq imm1,imm1,#t_offset)
1300        __(vpush1(imm1))
1301        __(cmp imm1,imm0)
1302        __(bne 1b)
1303        __(bx lr)
1304
1305/* Cons a list of length nargs  and vpush it.  */
1306/* Use this entry point to heap-cons a simple &rest arg.  */
1307_spentry(heap_rest_arg)
1308        __(vpush_argregs())
1309        __(movs imm1,nargs)
1310        __(mov arg_z,#nil_value)
1311        __(b 2f)
13121:
1313        __(vpop1(arg_y))
1314        __(Cons(arg_z,arg_y,arg_z))
1315        __(subs imm1,imm1,#fixnum_one)
13162:
1317        __(bne 1b)
1318        __(vpush1(arg_z))
1319        __(bx lr)
1320
1321 
1322/* And this entry point when the argument registers haven't yet been  */
1323/* vpushed (as is typically the case when required/&rest but no  */
1324/* &optional/&key.)  */
1325_spentry(req_heap_rest_arg)
1326        __(vpush_argregs())
1327        __(subs imm1,nargs,imm0)
1328        __(mov arg_z,#nil_value)
1329        __(b 2f)
13301:
1331        __(vpop1(arg_y))
1332        __(Cons(arg_z,arg_y,arg_z))
1333        __(subs imm1,imm1,#fixnum_one)
13342:
1335        __(bgt 1b)
1336        __(vpush1(arg_z))
1337        __(bx lr)
1338
1339/* Here where argregs already pushed */
1340_spentry(heap_cons_rest_arg)
1341        __(subs imm1,nargs,imm0)
1342        __(mov arg_z,#nil_value)
1343        __(b 2f)
13441:
1345        __(vpop1(arg_y))
1346        __(Cons(arg_z,arg_y,arg_z))
1347        __(subs imm1,imm1,#fixnum_one)
13482:
1349        __(bgt 1b)
1350        __(vpush1(arg_z))
1351        __(bx lr)
1352
1353
1354dnl _spentry(simple_keywords)
1355dnl  __(mov imm0,#0)
1356dnl         __(vpush_argregs())
1357dnl         __(b _SPkeyword_bind)
1358dnl                 
1359dnl _spentry(keyword_args)
1360dnl  __(vpush_argregs())
1361dnl         __(b _SPkeyword_bind)
1362dnl
1363dnl /* Treat the last (- nargs imm0) values on the vstack as keyword/value  */
1364dnl /* pairs.  There'll be imm3 keyword arguments.  Imm2 contains flags  */
1365dnl /* that indicate whether &allow-other-keys was specified and whether  */
1366dnl /* or not to leave the keyword/value pairs on the vstack for an &rest  */
1367dnl /* argument.  Temp3 contains a vector of keyword specifiers which we  */
1368dnl /* must (in general) match.  */
1369dnl /* If the number of arguments is greater than imm0, the difference must  */
1370dnl /* be even.  */
1371dnl /* Note that the caller hasn't yet saved its caller's context and that  */
1372dnl /* the temp registers used to pass next_method_context  */
1373dnl /* (temp1) may still have "live" values in them, as does nfn (temp2).  */
1374dnl
1375dnl define(`keyword_flags',`imm2')
1376dnl define(`keyword_vector',`temp3')
1377dnl define(`keyword_count',`imm3')
1378dnl
1379dnl
1380dnl
1381dnl define(`varptr',`save0')
1382dnl define(`valptr',`save1')
1383dnl define(`limit',`save2')
1384dnl
1385dnl _spentry(keyword_bind)
1386dnl         /* Before we can really do anything, we have to  */
1387dnl         /* save the caller's context.  To do so, we need to know  */
1388dnl         /* how many args have actually been pushed.  Ordinarily, that'd  */
1389dnl         /* be "nargs", but we may have pushed more args than we received  */
1390dnl  /* if we had to default any &optionals.  */
1391dnl  /* So, the number of args pushed so far is the larger of nargs  */
1392dnl  /* and the (canonical) total of required/&optional args received.  */
1393dnl  __(cmpr(nargs,imm0))
1394dnl  __(add arg_z,vsp,nargs)
1395dnl  __(bge+ 1f)
1396dnl  __(add arg_z,vsp,imm0)
1397dnl 1:
1398dnl  __(build_lisp_frame(fn,loc_pc,arg_z))
1399dnl  __(mov fn,nfn)
1400dnl  /* If there are key/value pairs to consider, we slide them down  */
1401dnl  /* the vstack to make room for the value/supplied-p pairs.  */
1402dnl  /* The first step in that operation involves pushing imm3 pairs  */
1403dnl  /* of NILs.  */
1404dnl  /* If there aren't any such pairs, the first step is the last  */
1405dnl  /* step.  */
1406dnl  __(cmp imm3,#0)
1407dnl  __(mov arg_z,#0)
1408dnl  __(sub imm1,nargs,imm0)
1409dnl  __(mov imm4,vsp) /* in case odd keywords error  */
1410dnl  __(cmpri(cr1,imm1,0))
1411dnl  __(b 3f)
1412dnl 2:
1413dnl  __(addi arg_z,arg_z,fixnum_one)
1414dnl  __(cmplr(arg_z,imm3))
1415dnl  __(mov imm5,#nil_value)
1416dnl  __(vpush1(imm5))
1417dnl  __(vpush1(imm5))
1418dnl 3:
1419dnl  __(bne 2b)
1420dnl  __(andi. arg_z,imm1,fixnum_one)
1421dnl  __(blelr cr1) /* no keyword/value pairs to consider.  */
1422dnl  __(bne odd_keywords)
1423dnl  /* We have key/value pairs.  Move them to the top of the vstack,  */
1424dnl  /* then set the value/supplied-p vars to NIL.  */
1425dnl  /* Have to use some save regs to do this.  */
1426dnl  __(vpush1(limit))
1427dnl  __(vpush1(valptr))
1428dnl  __(vpush1(varptr))
1429dnl  /* recompute ptr to user args in case stack overflowed  */
1430dnl  __(add imm4,vsp,imm3)
1431dnl  __(add imm4,imm4,imm3)
1432dnl  __(addi imm4,imm4,3*node_size)
1433dnl  /* error if odd number of keyword/value args  */
1434dnl  __(mov varptr,imm4)
1435dnl  __(la limit,3*node_size(vsp))
1436dnl  __(mov valptr,limit)
1437dnl  __(mov arg_z,imm1)
1438dnl 4:
1439dnl  __(mov imm4,#nil_value)
1440dnl  __(subi arg_z,arg_z,2<<fixnumshift)
1441dnl  __(cmplri(arg_z,0))
1442dnl  __(ldr arg_x,[varptr,#node_size*0])
1443dnl  __(ldr arg_y,[varptr,#node_size*1])
1444dnl  __(str(imm4,node_size*0(varptr)))
1445dnl  __(str(imm4,node_size*1(varptr)))
1446dnl  __(la varptr,node_size*2(varptr))
1447dnl  __(str(arg_x,node_size*0(valptr)))
1448dnl  __(str(arg_y,node_size*1(valptr)))
1449dnl  __(la valptr,node_size*2(valptr))
1450dnl  __(bne 4b)
1451dnl
1452dnl
1453dnl         /* Now, iterate through each supplied keyword/value pair.  If  */
1454dnl         /* it's :allow-other-keys and the corresponding value is non-nil,  */
1455dnl         /* note that other keys will be allowed.  */
1456dnl         /* Find its position in the function's keywords vector.  If that's  */
1457dnl         /* nil, note that an unknown keyword was encountered.  */
1458dnl         /* Otherwise, if the keyword arg hasn't already had a value supplied,  */
1459dnl         /* supply it.  */
1460dnl         /* When done, complain if any unknown keywords were found and that  */
1461dnl         /* situation was unexpected.  */
1462dnl  __(mov imm4,valptr)
1463dnl 5:
1464dnl         __(cmpri(keyword_flags,16<<fixnumshift)) /* seen :a-o-k yet ?  */
1465dnl  __(ldru(arg_z,-node_size(valptr)))
1466dnl  __(ldru(arg_y,-node_size(valptr)))
1467dnl  __(cmpri(cr1,arg_y,nil_value))
1468dnl  __(mov arg_x,#nrs.kallowotherkeys)
1469dnl         /* cr6_eq <- (eq current-keyword :allow-other-keys)  */
1470dnl  __(cmpr(cr6,arg_x,arg_z))
1471dnl  __(cmpr(cr7,valptr,limit))
1472dnl  __(bne cr6,6f)
1473dnl         __(bge 6f) /* Already seen :allow-other-keys  */
1474dnl         __(ori keyword_flags,keyword_flags,16<<fixnumshift)
1475dnl  __(beq cr1,6f)
1476dnl  __(ori keyword_flags,keyword_flags,fixnum_one)
1477dnl 6:
1478dnl  __(cmpri(cr1,imm3,0))
1479dnl  __(mov imm1,#misc_data_offset)
1480dnl  __(mov imm0,#0)
1481dnl  __(b 8f)
1482dnl 7:
1483dnl  __(addi imm0,imm0,fixnum_one)
1484dnl  __(cmpr(cr1,imm0,imm3))
1485dnl  __(ldrx(arg_x,keyword_vector,imm1))
1486dnl  __(cmpr(arg_x,arg_z))
1487dnl  __(addi imm1,imm1,fixnum_one)
1488dnl  __(bne 8f)
1489dnl  __(add imm0,imm0,imm0)
1490dnl  __(sub imm0,varptr,imm0)
1491dnl  __(ldr arg_x,[imm0,#0])
1492dnl  __(cmp arg_x,#nil_value)
1493dnl  __(mov arg_z,#t_value)
1494dnl  __(bne 9f)
1495dnl  __(str(arg_y,node_size(imm0)))
1496dnl  __(str(arg_z,0(imm0)))
1497dnl  __(b 9f)
1498dnl 8:
1499dnl  __(bne cr1,7b)
1500dnl  /* Unknown keyword. If it was :allow-other-keys, cr6_eq will still */
1501dnl         /* be set.  */
1502dnl         __(beq cr6,9f)
1503dnl  __(ori keyword_flags,keyword_flags,2<<fixnumshift)
1504dnl 9:
1505dnl  __(bne cr7,5b)
1506dnl  __(vpop(varptr))
1507dnl  __(vpop(valptr))
1508dnl  __(vpop(limit))
1509dnl  /* All keyword/value pairs have been processed.  */
1510dnl  /* If we saw an unknown keyword and didn't expect to, error.  */
1511dnl  /* Unless bit 2 is set in the fixnum in keyword_flags, discard the  */
1512dnl  /* keyword/value pairs from the vstack.  */
1513dnl  __(andi. imm0,keyword_flags,(fixnum_one)|(2<<fixnumshift))
1514dnl  __(cmpri(imm0,2<<fixnumshift))
1515dnl  __(beq- badkeys)
1516dnl  __(andi. imm2,keyword_flags,4<<fixnumshift)
1517dnl  __(bnelr cr0)
1518dnl  __(mov vsp,imm4)
1519dnl  __(bx lr)
1520dnl
1521dnl /* Signal an error.  We saved context on entry, so this thing doesn'*/
1522dnl /* have to.  */
1523dnl /* The "unknown keywords" error could be continuable (ignore them.)  */
1524dnl /* It might be hard to then cons an &rest arg.  */
1525dnl /* In the general case, it's hard to recover the set of args that were  */
1526dnl /* actually supplied to us ...  */
1527dnl /* For now, just cons a list out of the keyword/value pairs */
1528dnl /* that were actually provided, and signal an "invalid keywords" */
1529dnl /* error with that list as an operand.  */
1530dnl odd_keywords:
1531dnl  __(mov vsp,imm4)
1532dnl  __(mov nargs,imm1)
1533dnl  __(b 1f)
1534dnl badkeys:
1535dnl  __(sub nargs,imm4,vsp)
1536dnl 1:
1537dnl  __(bl _SPconslist)
1538dnl  __(mov arg_y,#XBADKEYS)
1539dnl  __(set_nargs(2))
1540dnl  __(b _SPksignalerr)
1541dnl
1542/* Signal an error synchronously, via %ERR-DISP.  */
1543/* If %ERR-DISP isn't fbound, it'd be nice to print a message  */
1544/* on the C runtime stderr.  */
1545 
1546_spentry(ksignalerr)
1547        __(ref_nrs_symbol(fname,errdisp,imm0))
1548        __(jump_fname)
1549
1550/* As in the heap-consed cases, only stack-cons the &rest arg  */
1551_spentry(stack_rest_arg)
1552        __(mov imm0,#0)
1553        __(vpush_argregs())
1554        __(b _SPstack_cons_rest_arg)
1555
1556_spentry(req_stack_rest_arg)
1557        __(vpush_argregs())
1558        __(b _SPstack_cons_rest_arg)
1559
1560_spentry(stack_cons_rest_arg)
1561        __(sub imm1,nargs,imm0)
1562        __(cmp imm1,#0)
1563        __(mov arg_z,#nil_value)
1564        __(ble 2f)  /* always temp-push something.  */
1565        __(add imm1,imm1,imm1)
1566        __(mov temp0,imm1)
1567        __(add imm1,imm1,#node_size)
1568        __(dnode_align(imm0,imm1,node_size))
1569        __(mov imm1,imm1,lsl #num_subtag_bits-fixnumshift)
1570        __(orr imm1,imm1,#subtag_u32_vector)
1571        __(cmp imm1,#stack_alloc_limit)
1572        __(bge 3f)
1573        __(stack_allocate_zeroed_ivector(imm1,imm0))
1574        __(mov imm0,#subtag_simple_vector)
1575        __(strb imm0,[sp])
1576        __(add imm0,sp,#dnode_size+fulltag_cons)
15771:
1578        __(subs temp0,temp0,#fixnumone)
1579        __(vpop1(arg_x))
1580        __(_rplacd(imm0,arg_z))
1581        __(_rplaca(imm0,arg_x))
1582        __(mov arg_z,imm0)
1583        __(add imm0,imm0,#cons.size)
1584        __(bne 1b)
1585        __(vpush1(arg_z))
1586        __(bx lr)
15872:
1588        __(movc16(imm0,make_header(1,subtag_u32_vector)))
1589        __(mov imm1,#0)
1590        __(stmdb sp!,{imm0,imm1})
1591        __(vpush1(arg_z))
1592        __(bx lr)
15933:
1594        __(movc16(imm0,make_header(1,subtag_u32_vector)))
1595        __(mov imm1,#0)
1596        __(stmdb sp!,{imm0,imm1})
1597        __(b _SPheap_cons_rest_arg)
1598
1599       
1600/* Prepend all but the first three (entrypoint, closure code, fn) and last two  */
1601/* (function name, lfbits) elements of nfn to the "arglist".  */
1602/* functions which take "inherited arguments" work consistently  */
1603/* even in cases where no closure object is created.  */
1604_spentry(call_closure)       
1605        __(cmp nargs,nargregs<<fixnumshift)
1606        __(vector_length(imm0,nfn,imm0))
1607        __(sub imm0,imm0,#5<<fixnumshift) /* imm0 = inherited arg count  */
1608        __(ble local_label(no_insert))
1609        /* Some arguments have already been vpushed.  Vpush imm0's worth  */
1610        /* of NILs, copy those arguments that have already been vpushed from  */
1611        /* the old TOS to the new, then insert all of the inerited args  */
1612        /* and go to the function.  */
1613        __(vpush_all_argregs())
1614        __(mov arg_x,imm0)
1615        __(mov arg_y,#nil_value)
1616local_label(push_nil_loop):
1617        __(subs arg_x,arg_x,#fixnumone)
1618        __(vpush1(arg_y))
1619        __(bne local_label(push_nil_loop))
1620        __(add arg_y,vsp,imm0)
1621        __(mov imm1,#0)
1622local_label(copy_already_loop): 
1623        __(ldr arg_x,[vsp,imm1])
1624        __(str arg_x,[arg_y,imm1])
1625        __(add imm1,imm1,#fixnumone)
1626        __(cmp imm1,imm0)
1627        __(bne local_label(copy_already_loop))
1628        __(mov imm1,#misc_data_offset+(3<<fixnumshift))
1629        __(add arg_y,vsp,nargs)
1630        __(add arg_y,arg_y,imm0)
1631local_label(insert_loop):
1632        __(subs imm0,imm0,#fixnumone)
1633        __(ldr fname,[nfn,imm1])
1634        __(add imm1,imm1,#fixnumone)
1635        __(add nargs,nargs,#fixnumone)
1636        __(push1(fname,arg_y))
1637        __(bne local_label(insert_loop))
1638        __(vpop_all_argregs())
1639        __(b local_label(go))
1640local_label(no_insert):
1641/* nargregs or fewer args were already vpushed.  */
1642/* if exactly nargregs, vpush remaining inherited vars.  */
1643        __(cmp nargs,#nargregs<<fixnumshift)
1644        __(add imm1,imm0,#misc_data_offset+(3<<fixnumshift))
1645        __(bne local_label(set_regs))
1646local_label(vpush_remaining):
1647        __(mov imm1,#misc_data_offset+(3<<fixnumshift))
1648local_label(vpush_remaining_loop):             
1649        __(ldr fname,[nfn,imm1])
1650        __(add imm1,imm1,#fixnum_one)
1651        __(vpush1(fname))
1652        __(subs imm0,imm0,#fixnum_one)
1653        __(add nargs,nargs,#fixnum_one)
1654        __(bne  local_label(vpush_remaining_loop))
1655        __(b local_label(go))
1656local_label(set_regs):
1657        /* if nargs was > 1 (and we know that it was < 3), it must have  */
1658        /* been 2.  Set arg_x, then vpush the remaining args.  */
1659        __(cmp nargs,#fixnumone)
1660        __(ble local_label(set_y_z))
1661local_label(set_arg_x):
1662        __(subs imm0,imm0,#fixnum_one)
1663        __(sub imm1,imm1,#fixnum_one)
1664        __(ldr arg_x,[nfn,imm1])
1665        __(add nargs,nargs,#fixnum_one)
1666        __(bne local_label(vpush_remaining))
1667        __(b local_label(go))
1668        /* Maybe set arg_y or arg_z, preceding args  */
1669local_label(set_y_z):
1670        __(cmp nargs,#fixnumone)
1671        __(bne local_label(set_arg_z))
1672        /* Set arg_y, maybe arg_x, preceding args  */
1673local_label(set_arg_y):
1674        __(subs imm0,imm0,fixnum_one)
1675        __(sub imm1,imm1,#fixnum_one)
1676        __(ldr arg_y,[nfn,imm1])
1677        __(add nargs,nargs,#fixnum_one)
1678        __(bne local_label(set_arg_x))
1679        __(b local_label(go))
1680local_label(set_arg_z):
1681        __(subs imm0,imm0,#fixnum_one)
1682        __(sub imm1,imm1,#fixnum_one)
1683        __(ldr arg_z,[nfn,imm1])
1684        __(add nargs,nargs,#fixnum_one)
1685        __(bne local_label(set_arg_y))
1686 
1687local_label(go):
1688        __(vrefr(nfn,nfn,2))
1689        __(ldr pc,[nfn,#_function.entrypoint])
1690
1691
1692/* Everything up to the last arg has been vpushed, nargs is set to  */
1693/* the (boxed) count of things already pushed.  */
1694/* On exit, arg_x, arg_y, arg_z, and nargs are set as per a normal  */
1695/* function call (this may require vpopping a few things.)  */
1696/* ppc2-invoke-fn assumes that temp1 is preserved here.  */
1697_spentry(spreadargz)
1698        __(extract_lisptag(imm1,arg_z))
1699        __(cmp arg_z,#nil_value)
1700        __(mov imm0,#0)
1701        __(mov arg_y,arg_z)  /*  save in case of error  */
1702        __(beq 2f)
17031:
1704        __(cmp imm1,#tag_list)
1705        __(bne 3f)
1706        __(_car(arg_x,arg_z))
1707        __(_cdr(arg_z,arg_z))
1708        __(cmp arg_z,#nil_value)
1709        __(extract_lisptag(imm1,arg_z))
1710        __(vpush1(arg_x))
1711        __(add imm0,imm0,#fixnum_one)
1712        __(bne 1b)
17132:
1714        __(adds  nargs,nargs,imm0)
1715        __(bxeq lr)
1716        __(vpop_argregs_nz)
1717        __(bx lr)
1718       
1719        /*  Discard whatever's been vpushed already, complain.  */
17203:
1721        __(add vsp,vsp,imm0)
1722        __(mov arg_z,arg_y)  /* recover original arg_z  */
1723        __(mov arg_y,#XNOSPREAD)
1724        __(set_nargs(2))
1725        __(b _SPksignalerr)
1726
1727/* Tail-recursively funcall temp0.  */
1728/* Pretty much the same as the tcallsym* cases above.  */
1729_spentry(tfuncallgen)
1730        __(cmp nargs,#nargregs<<fixnumshift)
1731        __(ldr lr,[sp,#lisp_frame.savelr])
1732        __(ldr fn,[sp,#lisp_frame.savefn])
1733        __(ble 2f)
1734        __(ldr imm0,[sp,#lisp_frame.savevsp])
1735        __(discard_lisp_frame())
1736        /* can use temp0 as a temporary  */
1737        __(sub imm1,nargs,#nargregs<<fixnumshift)
1738        __(add imm1,imm1,vsp)
17391:
1740        __(ldr temp0,[imm1,#-node_size]!)
1741        __(cmp imm1,vsp)
1742        __(push1(temp2,imm0))
1743        __(bne 1b)
1744        __(mov vsp,imm0)
1745        __(funcall_nfn())
17462:
1747        __(ldr vsp,[sp,#lisp_frame.savevsp])
1748        __(discard_lisp_frame())
1749        __(funcall_nfn())
1750
1751
1752/* Some args were vpushed.  Slide them down to the base of  */
1753/* the current frame, then do funcall.  */
1754_spentry(tfuncallslide)
1755        __(restore_lisp_frame(imm0))
1756        /* can use temp0 as a temporary  */
1757        __(sub imm1,nargs,#nargregs<<fixnumshift)
1758        __(add imm1,imm1,vsp)
17591:
1760        __(ldr temp0,[imm1,#-node_size]!)
1761        __(cmp imm1,vsp)
1762        __(push1(temp0,imm0))
1763        __(bne 1b)
1764        __(mov vsp,imm0)
1765        __(funcall_nfn())
1766
1767/* No args were vpushed; recover saved context & do funcall  */
1768_spentry(tfuncallvsp)
1769        __(restore_lisp_frame(imm0))
1770        __(funcall_nfn())
1771
1772/* Tail-recursively call the (known symbol) in fname.  */
1773/* In the general case, we don't know if any args were  */
1774/* vpushed or not.  If so, we have to "slide" them down  */
1775/* to the base of the frame.  If not, we can just restore  */
1776/* vsp, lr, fn from the saved lisp frame on the control stack.  */
1777_spentry(tcallsymgen)
1778        __(cmp nargs,#nargregs<<fixnumshift)
1779        __(ldr lr,[sp,#lisp_frame.savelr])
1780        __(ldr fn,[sp,#lisp_frame.savefn])
1781        __(ble 2f)
1782
1783        __(ldr imm0,[sp,#lisp_frame.savevsp])
1784        __(discard_lisp_frame())
1785        /* can use nfn (= temp2) as a temporary  */
1786        __(sub imm1,nargs,#nargregs<<fixnumshift)
1787        __(add imm1,imm1,vsp)
17881:
1789        __(ldr temp2,[imm1,#-node_size]!)
1790        __(cmp imm1,vsp)
1791        __(push1(temp2,imm0))
1792        __(bne 1b)
1793        __(mov vsp,imm0)
1794        __(jump_fname)
1795 
17962: 
1797        __(ldr vsp,[sp,#lisp_frame.savevsp])
1798        __(discard_lisp_frame())
1799        __(jump_fname)
1800
1801
1802/* Some args were vpushed.  Slide them down to the base of  */
1803/* the current frame, then do funcall.  */
1804_spentry(tcallsymslide)
1805        __(ldr lr,[sp,#lisp_frame.savelr])
1806        __(ldr fn,[sp,#lisp_frame.savefn])
1807        __(ldr imm0,[sp,#lisp_frame.savevsp])
1808        __(discard_lisp_frame())
1809        /* can use nfn (= temp2) as a temporary  */
1810        __(sub imm1,nargs,#nargregs<<fixnumshift)
1811        __(add imm1,imm1,vsp)
18121:
1813        __(ldr temp2,[imm1,#-node_size]!)
1814        __(cmp imm1,vsp)
1815        __(push1(temp2,imm0))
1816        __(bne 1b)
1817        __(mov vsp,imm0)
1818        __(jump_fname)
1819
1820/* No args were vpushed; recover saved context & call symbol  */
1821_spentry(tcallsymvsp)
1822        __(restore_lisp_frame(imm0))
1823        __(jump_fname)
1824
1825/* Tail-recursively call the function in nfn.  */
1826/* Pretty much the same as the tcallsym* cases above.  */
1827_spentry(tcallnfngen)
1828        __(cmp nargs,#nargregs<<fixnumshift)
1829        __(ble _SPtcallnfnvsp)
1830        __(b _SPtcallnfnslide)
1831 
1832/* Some args were vpushed.  Slide them down to the base of  */
1833/* the current frame, then do funcall.  */
1834_spentry(tcallnfnslide)
1835        __(ldr lr,[sp,#lisp_frame.savelr])
1836        __(ldr fn,[sp,#lisp_frame.savefn])
1837        __(ldr imm0,[sp,#lisp_frame.savevsp])
1838        __(discard_lisp_frame())
1839        /* Since we have a known function, can use fname as a temporary.  */
1840        __(sub imm1,nargs,#nargregs<<fixnumshift)
1841        __(add imm1,imm1,vsp)
18421:
1843        __(ldr fname,[imm1,#-node_size]!)
1844        __(cmp imm1,vsp)
1845        __(push1(fname,imm0))
1846        __(bne 1b)
1847        __(mov vsp,imm0)
1848        __(jump_nfn())
1849
1850_spentry(tcallnfnvsp)
1851        __(restore_lisp_frame(imm0))
1852        __(jump_nfn())
1853
1854/* Reference index arg_z of a misc-tagged object (arg_y).  */
1855/* Note that this conses in some cases.  Return a properly-tagged  */
1856/* lisp object in arg_z.  Do type and bounds-checking.  */
1857
1858_spentry(misc_ref)
1859        __(trap_unless_fulltag_equal(arg_y,fulltag_misc,imm0))
1860        __(trap_unless_fixnum(arg_z))
1861        __(vector_length(imm0,arg_y,imm1))
1862        __(cmp arg_z,imm0)
1863        __(uuo_error_vector_bounds(hs,arg_z,arg_y))
1864        __(extract_lowbyte(imm1,imm1)) /* imm1 = subtag  */
1865        __(b C(misc_ref_common)) 
1866
1867/* like misc_ref, only the boxed subtag is in arg_x.  */
1868
1869_spentry(subtag_misc_ref)
1870        __(trap_unless_fulltag_equal(arg_y,fulltag_misc,imm0))
1871        __(trap_unless_fixnum(arg_z))
1872        __(vector_length(imm0,arg_y,imm1))
1873        __(cmp arg_z,imm0)
1874        __(uuo_error_vector_bounds(hs,arg_z,arg_y))
1875        __(unbox_fixnum(imm1,arg_x))
1876        __(b C(misc_ref_common))
1877
1878
1879/* Make a "raw" area on the temp stack, stack-cons a macptr to point to it,  */
1880/* and return the macptr.  Size (in bytes, boxed) is in arg_z on entry; macptr */
1881/* in arg_z on exit.  */
1882_spentry(makestackblock)
1883        __(unbox_fixnum(imm1,arg_z))
1884        __(dnode_align(imm1,imm1,0))
1885        __(add imm1,imm1,#macptr.size+node_size)
1886        __(add imm0,imm1,#node_size)
1887        __(mov imm1,imm1,lsl #num_subtag_bits)
1888        __(orr imm1,imm1,#subtag_u8_vector)
1889        __(cmp imm0,#stack_alloc_limit)
1890        __(bhs 1f)
1891        __(stack_allocate_ivector(imm1,imm0))
1892        __(movc16(imm1,make_header(macptr.element_count,subtag_macptr)))
1893        __(str imm1,[sp,#dnode_size])
1894        __(mov imm0,#0)
1895        __(str imm0,[sp,#dnode_size+macptr.type-fulltag_misc])
1896        __(str imm0,[sp,#dnode_size+macptr.domain-fulltag_misc])
1897        __(add imm0,sp,#macptr.size+dnode_size)
1898        __(str imm0,[sp,#dnode_size+macptr.address-fulltag_misc])
1899        __(add arg_z,sp,#dnode_size+fulltag_misc)
1900        __(bx lr)
1901
1902        /* Too big. Heap cons a gcable macptr  */
19031:
1904        __(mov imm1,#subtag_u8_vector)
1905        __(str imm1,[sp,#-dnode_size]!)
1906        __(set_nargs(1))
1907        __(ref_nrs_symbol(fname,new_gcable_ptr,imm0))
1908        __(jump_fname())
1909
1910/* As above, only set the block's contents to 0.  */
1911_spentry(makestackblock0)
1912        __(unbox_fixnum(imm1,arg_z))
1913        __(dnode_align(imm1,imm1,0))
1914        __(add imm1,imm1,#macptr.size+node_size)
1915        __(add imm0,imm1,#node_size)
1916        __(mov imm1,imm1,lsl #num_subtag_bits)
1917        __(orr imm1,imm1,#subtag_u8_vector)
1918        __(cmp imm0,#stack_alloc_limit)
1919        __(bhs 1f)
1920        __(stack_allocate_zeroed_ivector(imm1,imm0))
1921        __(movc16(imm1,make_header(macptr.element_count,subtag_macptr)))
1922        __(str imm1,[sp,#dnode_size])
1923        __(add imm0,sp,#macptr.size+dnode_size)
1924        __(str imm0,[sp,#dnode_size+macptr.address-fulltag_misc])
1925        __(add arg_z,sp,#dnode_size+fulltag_misc)
1926        __(bx lr)
1927        /* Too big. Heap cons a gcable macptr  */
19281:
1929        __(mov imm1,#subtag_u8_vector)
1930        __(str imm1,[sp,#-dnode_size]!)
1931        __(mov arg_y,arg_z) /* save block size  */
1932        __(mov arg_z,#nil_value) /* clear-p arg to %new-gcable-ptr  */
1933        __(add arg_z,arg_z,#t_offset)
1934        __(set_nargs(2))
1935        __(ref_nrs_symbol(fname,new_gcable_ptr,imm0))
1936        __(jump_fname())
1937
1938/* Make a list of length arg_y (boxed), initial-element arg_z (boxed) on  */
1939/* the tstack.  Return the list in arg_z.  */
1940_spentry(makestacklist)
1941        __(add imm0,arg_y,arg_y)
1942        __(mov imm1,imm0,lsl #num_subtag_bits-fixnumshift)
1943        __(add imm1,imm1,#4<<num_subtag_bits)
1944        __(orr imm1,imm1,#subtag_u32_vector)
1945        __(add imm0,imm0,#dnode_size)
1946        __(cmp imm0,#stack_alloc_limit)
1947        __(bge 4f)
1948        __(stack_allocate_zeroed_ivector(imm1,imm0))
1949        __(mov imm0,#subtag_simple_vector)
1950        __(strb imm0,[sp,#0])
1951        __(add imm2,sp,#dnode_size+fulltag_cons)
1952        __(movs imm1,arg_y)
1953        __(mov arg_y,arg_z)
1954        __(mov arg_z,#nil_value)
1955        __(b 3f)
19562:
1957        __(_rplacd(imm2,arg_z))
1958        __(_rplaca(imm2,arg_y))
1959        __(mov arg_z,imm2)
1960        __(add imm2,imm2,#cons.size)
1961        __(subs imm1,imm1,#fixnumone)
19623:
1963        __(bne 2b)
1964        __(bx lr)
19654:
1966        __(movc16(imm0,make_header(1,subtag_u32_vector)))
1967        __(str imm0,[sp,#-8]!)
1968        __(movs imm1,arg_y) /* count  */
1969        __(mov arg_y,arg_z) /* initial value  */
1970        __(mov arg_z,#nil_value) /* result  */
1971        __(b 6f)
19725:
1973        __(Cons(arg_z,arg_y,arg_z))
1974        __(subs imm1,imm1,#fixnumone)
19756:
1976        __(bne 5b)
1977        __(bx lr)
1978
1979/* subtype (boxed) vpushed before initial values. (Had better be a  */
1980/* node header subtag.) Nargs set to count of things vpushed.  */
1981
1982_spentry(stkgvector)
1983        __(sub imm0,nargs,#fixnumone)
1984        __(ldr temp0,[vsp,imm0])
1985        __(dnode_align(temp1,imm0,node_size))
1986        __(mov imm1,imm0,lsl #num_subtag_bits-fixnumshift)
1987        __(orr imm1,imm1,#subtag_u32_vector)
1988        __(stack_allocate_zeroed_ivector(imm1,temp1))
1989        __(unbox_fixnum(imm1,temp0))
1990        __(strb imm1,[sp])
1991        __(add arg_z,sp,#fulltag_misc)
1992        __(add imm0,sp,nargs)
1993        __(b 2f)
19941:
1995        __(vpop1(temp0))
1996        __(push1(temp0,imm0))
19972:      __(subs nargs,nargs,#fixnumone)
1998        __(bne 1b)
1999        __(add vsp,vsp,#fixnumone)
2000        __(bx lr)
2001
2002/* Allocate a "fulltag_misc" object.  On entry, arg_y contains the element  */
2003/* count (boxed) and  arg_z contains the subtag (boxed).  Both of these   */
2004/* parameters must be "reasonable" (the  subtag must be valid, the element  */
2005/* count must be of type (unsigned-byte 24)/(unsigned-byte 56).   */
2006/* On exit, arg_z contains the (properly tagged) misc object; it'll have a  */
2007/* proper header on it and its contents will be 0.   imm0 contains   */
2008/* the object's header (fulltag = fulltag_immheader or fulltag_nodeheader.)  */
2009
2010_spentry(misc_alloc)
2011        __(tst arg_y,#unsigned_byte_24_mask)
2012        __(bne 9f)
2013        __(unbox_fixnum(imm0,arg_z))
2014        __(orr imm0,imm0,arg_y,lsl #num_subtag_bits-fixnumshift)
2015        __(extract_fulltag(imm1,imm0))
2016        __(cmp imm1,#fulltag_nodeheader)
2017        __(mov imm2,arg_y)      /* imm2 = logical size in bytes */
2018        __(beq 1f)
2019        __(unbox_fixnum(imm1,arg_z))
2020        __(cmp imm1,#max_32_bit_ivector_subtag)
2021        __(ble 1f)
2022        __(mov imm2,arg_y,lsr #2)
2023        __(cmp imm1,#max_8_bit_ivector_subtag)
2024        __(ble 1f)
2025        __(mov imm2,arg_y,lsr #1)
2026        __(cmp imm1,#max_16_bit_ivector_subtag)
2027        __(ble 1f)
2028        __(mov imm2,arg_y,lsl #1)
2029        __(add imm2,imm2,#node_size)
2030        __(cmp imm1,#subtag_double_float_vector)
2031        __(beq 1f)
2032        __(add imm2,arg_y,#7<<fixnumshift)
2033        __(mov imm2,imm2,lsr #3+fixnumshift)
2034        /* imm2 now = byte count.  Add 4 for header, 7 to align, then clear */
2035        /* low three bits.  */
20361:
2037        __(dnode_align(imm2,imm2,node_size))
2038        __(Misc_Alloc(arg_z,imm0,imm2))
2039        __(bx lr)
20409:
2041        __(uuo_error_reg_not_xtype(al,arg_y,xtype_unsigned_byte_24))
2042
2043
2044
2045/* Destructuring-bind, macro-bind.  */
2046   
2047/* OK to use arg_x, arg_y for whatever (tagged) purpose;  */
2048/* likewise immX regs.  */
2049/* arg_z preserved, nothing else in particular defined on exit.  */
2050/* nargs contains req count (0-255) in PPC bits mask_req_start/mask_req_width,  */
2051/* opt count (0-255) in PPC bits mask_opt_start/mask_opt_width,  */
2052/* key count (0-255) in PPC bits mask_key_start/mask_key_width,  */
2053/* opt-supplied-p flag in PPC bit mask_initopt,  */
2054/* keyp flag in PPC bit mask_keyp,  */
2055/* &allow-other-keys flag in PPC bit mask_aok,  */
2056/* &rest flag in PPC bit mask_restp.  */
2057/* When mask_keyp bit is set, keyvect contains vector of keyword symbols,  */
2058/* length key count.  */
2059
2060_spentry(macro_bind)
2061        __(mov whole_reg,arg_reg)
2062        __(extract_lisptag(imm0,arg_reg))
2063        __(cmp imm0,#tag_list)
2064        __(bne 1f)
2065        __(_cdr(arg_reg,arg_reg))
2066        __(b C(destbind1))
20671:
2068        __(mov arg_y,#XCALLNOMATCH)
2069        __(mov arg_z,whole_reg)
2070        __(set_nargs(2))
2071        __(b _SPksignalerr)
2072
2073_spentry(destructuring_bind)
2074        __(mov whole_reg,arg_reg)
2075        __(b C(destbind1))
2076
2077_spentry(destructuring_bind_inner)
2078        __(mov whole_reg,arg_z)
2079        __(b C(destbind1))
2080
2081dnl /* vpush the values in the value set atop the vsp, incrementing nargs.  */
2082dnl /* Discard the tsp frame; leave values atop the vsp.  */
2083dnl
2084dnl _spentry(recover_values)
2085dnl
2086dnl /* First, walk the segments reversing the pointer to previous segment pointers  */
2087dnl /* Can tell the end because that previous segment pointer is the prev tsp pointer  */
2088dnl  __(ldr imm0,[tsp,#tsp_frame.backlink]) /* previous tsp  */
2089dnl  __(mov imm1,tsp) /* current segment  */
2090dnl  __(mov imm2,tsp) /* last segment  */
2091dnl local_label(walkloop):
2092dnl  __(ldr imm3,[imm1,#tsp_frame.fixed_overhead+node_size]) /* next segment  */
2093dnl  __(cmpr(imm0,imm3)) /* last segment?  */
2094dnl  __(str(imm2,tsp_frame.fixed_overhead+node_size(imm1))) /* reverse pointer  */
2095dnl  __(mov imm2,imm1) /* last segment <- current segment  */
2096dnl  __(mov imm1,imm3) /* current segment <- next segment  */
2097dnl  __(bne local_label(walkloop))
2098dnl
2099dnl         /* the final segment ptr is now in imm2  */
2100dnl         /* walk backwards, pushing values on VSP and incrementing NARGS  */
2101dnl local_label(pushloop):
2102dnl  __(ldr imm0,[imm2,#tsp_frame.data_offset]) /* nargs in segment  */
2103dnl  __(cmpri(imm0,0))
2104dnl  __(cmpr(cr1,imm2,tsp))
2105dnl  __(la imm3,tsp_frame.data_offset+(2*node_size)(imm2))
2106dnl  __(add imm3,imm3,imm0)
2107dnl  __(add nargs,nargs,imm0)
2108dnl  __(b 2f)
2109dnl 1:
2110dnl  __(ldru(arg_z,-node_size(imm3)))
2111dnl  __(cmpri(imm0,fixnum_one))
2112dnl  __(subi imm0,imm0,fixnum_one)
2113dnl  __(vpush1(arg_z))
2114dnl 2:
2115dnl  __(bne 1b)
2116dnl  __(ldr imm2,[imm2,#tsp_frame.data_offset+node_size]) /* previous segment  */
2117dnl  __(bne cr1,local_label(pushloop))
2118dnl  __(unlink(tsp))
2119dnl  __(bx lr)
2120
2121
2122/* Go out of line to do this.  Sheesh.  */
2123_spentry(vpopargregs)
2124        __(cmp nargs,#0)
2125        __(bxeq lr)
2126        __(vpop_argregs_nz)
2127        __(bx lr)
2128
2129/* If arg_z is an integer, return in imm0 something whose sign  */
2130/* is the same as arg_z's.  If not an integer, error.  */
2131_spentry(integer_sign)
2132        __(test_fixnum(arg_z))
2133        __(moveq imm0,arg_z)
2134        __(bxeq lr)
2135        __(extract_typecode(imm0,arg_z))
2136        __(cmp imm0,#subtag_bignum)
2137        __(uuo_error_reg_not_xtype(ne,arg_z,xtype_integer))
2138        __(getvheader(imm0,arg_z))
2139        __(header_length(imm0,imm0)) /* boxed length = scaled size  */
2140        __(add imm0,imm0,#misc_data_offset-4) /* bias, less 1 element  */
2141        __(ldr imm0,[arg_z,imm0])
2142        __(cmp imm0,#0)
2143        __(movge imm0,#1)
2144        __(movlt imm0,#-1)
2145        __(bx lr)
2146
2147
2148/* like misc_set, only pass the (boxed) subtag in temp0  */
2149_spentry(subtag_misc_set)
2150        __(trap_unless_fulltag_equal(arg_x,fulltag_misc,imm0))
2151        __(trap_unless_fixnum(arg_y))
2152        __(vector_length(imm0,arg_x,imm1))
2153        __(cmp arg_y,imm0)
2154        __(uuo_error_vector_bounds(hs,arg_y,arg_x))
2155        __(unbox_fixnum(imm1,temp0))
2156        __(b C(misc_set_common))
2157
2158
2159
2160/* misc_set (vector index newval).  Pretty damned similar to  */
2161/* misc_ref, as one might imagine.  */
2162
2163_spentry(misc_set)
2164        __(trap_unless_fulltag_equal(arg_x,fulltag_misc,imm0))
2165        __(trap_unless_fixnum(arg_y))
2166        __(vector_length(imm0,arg_x,imm1))
2167        __(cmp arg_y,imm0)
2168        __(uuo_error_vector_bounds(hs,arg_y,arg_x))
2169        __(extract_lowbyte(imm1,imm1))
2170        __(b C(misc_set_common))
2171dnl         
2172dnl /* "spread" the lexpr in arg_z.  */
2173dnl /* ppc2-invoke-fn assumes that temp1 is preserved here.  */
2174dnl _spentry(spread_lexprz)
2175dnl  __(ldr imm0,[arg_z,#0])
2176dnl  __(cmpri(cr3,imm0,3<<fixnumshift))
2177dnl  __(cmpri(cr4,imm0,2<<fixnumshift))
2178dnl  __(add imm1,arg_z,imm0)
2179dnl  __(cmpri(imm0,0))
2180dnl  __(add nargs,nargs,imm0)
2181dnl  __(cmpri(cr1,nargs,0))
2182dnl  __(cmpri(cr2,nargs,2<<fixnumshift))
2183dnl  __(la imm1,node_size(imm1))
2184dnl  __(bge cr3,9f)
2185dnl  __(beq cr4,2f)
2186dnl  __(bne 1f)
2187dnl  /* lexpr count was 0; vpop the arg regs that  */
2188dnl  /* were vpushed by the caller  */
2189dnl  __(beqlr cr1)
2190dnl  __(vpop(arg_z))
2191dnl  __(bltlr cr2)
2192dnl  __(vpop(arg_y))
2193dnl  __(beqlr cr2)
2194dnl  __(vpop(arg_x))
2195dnl  __(bx lr)
2196dnl
2197dnl  /* vpush args from the lexpr until we have only  */
2198dnl  /* three left, then assign them to arg_x, arg_y,  */
2199dnl  /* and arg_z.  */
2200dnl 8:
2201dnl  __(cmpri(cr3,imm0,4<<fixnumshift))
2202dnl  __(subi imm0,imm0,#fixnumone)
2203dnl  __(ldru(arg_z,-node_size(imm1)))
2204dnl  __(vpush1(arg_z))
2205dnl 9:
2206dnl  __(bne cr3,8b)
2207dnl  __(ldr arg_x,[imm1,#-node_size*1])
2208dnl  __(ldr arg_y,[imm1,#-node_size*2])
2209dnl  __(ldr arg_z,[imm1,#-node_size*3])
2210dnl  __(bx lr)
2211dnl
2212dnl  /* lexpr count is two: set arg_y, arg_z from the  */
2213dnl  /* lexpr, maybe vpop arg_x  */
2214dnl 2: 
2215dnl  __(ldr arg_y,[imm1,#-node_size*1])
2216dnl  __(ldr arg_z,[imm1,#-node_size*2])
2217dnl  __(beqlr cr2)  /* return if (new) nargs = 2  */
2218dnl  __(vpop(arg_x))
2219dnl  __(bx lr)
2220dnl
2221dnl  /* lexpr count is one: set arg_z from the lexpr,  */
2222dnl  /* maybe vpop arg_y, arg_x  */
2223dnl 1: 
2224dnl  __(ldr arg_z,[imm1,#-node_size])
2225dnl  __(bltlr cr2)  /* return if (new) nargs < 2  */
2226dnl  __(vpop(arg_y))
2227dnl  __(beqlr cr2)  /* return if (new) nargs = 2  */
2228dnl  __(vpop(arg_x))
2229dnl  __(bx lr)
2230dnl         
2231dnl   
2232dnl _spentry(reset)
2233dnl  .globl _SPthrow
2234dnl  __(nop)
2235dnl  __(ref_nrs_value(temp0,toplcatch))
2236dnl  __(mov temp1,#XSTKOVER)
2237dnl  __(vpush1(temp0))
2238dnl  __(vpush1(temp1))
2239dnl  __(set_nargs(1))
2240dnl  __(b _SPthrow)
2241dnl
2242dnl 
2243dnl /* "slide" nargs worth of values up the vstack.  IMM0 contains  */
2244dnl /* the difference between the current VSP and the target.  */
2245dnl _spentry(mvslide)
2246dnl  __(cmpri(nargs,0))
2247dnl  __(mov imm3,nargs)
2248dnl  __(add imm2,vsp,nargs)
2249dnl  __(add imm2,imm2,imm0)
2250dnl  __(add imm0,vsp,nargs)
2251dnl  __(beq 2f)
2252dnl 1:
2253dnl  __(cmpri(imm3,1<<fixnumshift))
2254dnl  __(subi imm3,imm3,1<<fixnumshift)
2255dnl  __(ldru(temp0,-node_size(imm0)))
2256dnl  __(stru(temp0,-node_size(imm2)))
2257dnl  __(bne 1b)
2258dnl 2:
2259dnl  __(mov vsp,imm2)
2260dnl  __(bx lr)
2261dnl
2262dnl /* Build a new TSP area to hold nargs worth of multiple-values.  */
2263dnl /* Pop the multiple values off of the vstack.  */
2264dnl /* The new TSP frame will look like this:  */
2265dnl /*  */
2266dnl /*+--------+-------+-------+---------+--------+--------+--------+======+----------+ */
2267dnl /*| ptr to | zero  | nargs | ptr to  | valn-1 | valn-2 | val-0  | ???? | prev TSP |  */
2268dnl /*|  prev  |       |       |  prev   |        |        |        | fill |          |  */
2269dnl /*| TSP    |       |       | segment |        |        |        |      |          | */
2270dnl /*+--------+-------+-------+---------+--------+--------+--------+------+----------+  */
2271dnl /*  */
2272dnl /* e.g., the first multiple value goes in the last cell in the frame, the  */
2273dnl /* count of values goes in the first word, and the word after the value count  */
2274dnl /* is 0 if the number of values is even (for alignment).  */
2275dnl /* Subsequent calls to .SPadd_values preserve this alignment.  */
2276dnl /* .SPrecover_values is therefore pretty simple.  */
2277dnl
2278dnl _spentry(save_values)
2279dnl  __(mov imm1,tsp)
2280dnl
2281dnl         /* common exit: nargs = values in this set, imm1 = ptr to tsp before  */
2282dnl         /* call to save_values  */
2283dnl local_label(save_values_to_tsp):
2284dnl  __(mov imm2,tsp)
2285dnl  __(dnode_align(imm0,nargs,tsp_frame.fixed_overhead+(2*node_size))) /* count, link  */
2286dnl  __(TSP_Alloc_Var_Boxed_nz(imm0,imm3))
2287dnl  __(str(imm1,tsp_frame.backlink(tsp))) /* keep one tsp "frame" as far as rest of lisp is concerned  */
2288dnl  __(str(nargs,tsp_frame.data_offset(tsp)))
2289dnl  __(str(imm2,tsp_frame.data_offset+node_size(tsp))) /* previous tsp  */
2290dnl  __(la imm3,tsp_frame.data_offset+node_size*2(tsp))
2291dnl  __(add imm3,imm3,nargs)
2292dnl  __(add imm0,vsp,nargs)
2293dnl  __(cmpr(imm0,vsp))
2294dnl  __(b 2f)
2295dnl 1:
2296dnl  __(ldru(arg_z,-node_size(imm0)))
2297dnl  __(cmpr(imm0,vsp))
2298dnl  __(stru(arg_z,-node_size(imm3)))
2299dnl 2:
2300dnl  __(bne 1b)
2301dnl  __(add vsp,vsp,nargs) /*  discard values  */
2302dnl  __(bx lr)
2303dnl 
2304dnl
2305dnl /* Add the multiple values that are on top of the vstack to the set  */
2306dnl /* saved in the top tsp frame, popping them off of the vstack in the  */
2307dnl /* process.  It is an error (a bad one) if the TSP contains something  */
2308dnl /* other than a previously saved set of multiple-values.  */
2309dnl /* Since adding to the TSP may cause a new TSP segment to be allocated,  */
2310dnl /* each add_values call adds another linked element to the list of  */
2311dnl /* values. This makes recover_values harder.  */
2312dnl
2313dnl _spentry(add_values)
2314dnl  __(cmpri(nargs,0))
2315dnl  __(ldr imm1,[tsp,#0])
2316dnl  __(bne local_label(save_values_to_tsp))
2317dnl  __(bx lr)
2318dnl         
2319
2320/* Like misc_alloc (a LOT like it, since it does most of the work), but takes  */
2321/* an initial-value arg in arg_z, element_count in arg_x, subtag in arg_y.  */
2322/* Calls out to %init-misc, which does the rest of the work.  */
2323
2324_spentry(misc_alloc_init)
2325        __(build_lisp_frame(imm0))
2326        __(mov fn,#0)
2327        __(mov temp2,arg_z)  /* initval  */
2328        __(mov arg_z,arg_y)  /* subtag  */
2329        __(mov arg_y,arg_x)  /* element-count  */
2330        __(bl _SPmisc_alloc)
2331        __(restore_lisp_frame(imm0))
2332        __(ref_nrs_symbol(fname,init_misc,imm0))
2333        __(set_nargs(2))
2334        __(mov arg_y,temp2)
2335        __(jump_fname())
2336
2337/* As in stack_misc_alloc above, only with a non-default initial-value.  */
2338/* The funny part here is that we build a lisp frame, then push a vector
2339/* on top of it.  Shuffle things around, carefully. */       
2340               
2341 
2342_spentry(stack_misc_alloc_init)
2343        __(build_lisp_frame(imm0))
2344        __(mov arg_x,sp)
2345        __(mov fn,#0)
2346        __(mov temp2,arg_z) /* initval  */
2347        __(mov arg_z,arg_y) /* subtag  */
2348        __(mov arg_y,arg_x) /* element-count  */
2349        __(bl _SPstack_misc_alloc)
2350        __(mov imm0,#0)
2351        __(ldr lr,[arg_x,#lisp_frame.savelr])
2352        __(ldr fn,[arg_x,#lisp_frame.savefn])
2353        __(ldr vsp,[arg_x,#lisp_frame.savevsp])
2354        __(ldr imm1,[sp])
2355        __(add imm2,imm1,#lisp_frame.size)
2356        __(str imm2,[sp])
2357        __(str imm0,[arg_x,#lisp_frame.savelr])
2358        __(str imm0,[arg_x,#lisp_frame.savefn])
2359        __(str imm0,[arg_x,#lisp_frame.savevsp])
2360        __(str imm0,[arg_x,#lisp_frame.marker])
2361        __(str imm1,[sp,#lisp_frame.size]!)
2362        __(add arg_z,arg_z,#lisp_frame.size)
2363        __(ref_nrs_symbol(fname,init_misc,imm0))
2364        __(set_nargs(2))
2365        __(mov arg_y,temp2)
2366        __(jump_fname())
2367 
2368_spentry(popj)
2369        .globl C(popj)
2370C(popj):
2371        __(return_lisp_frame(imm0))
2372
2373dnl
2374dnl _spentry(restorefullcontext)
2375dnl  __(mflr loc_pc)
2376dnl  __(mtctr loc_pc)
2377dnl  __(ldr loc_pc,[sp,#lisp_frame.savelr])
2378dnl  __(mtlr loc_pc)
2379dnl  __(ldr vsp,[sp,#lisp_frame.savevsp])
2380dnl  __(ldr fn,[sp,#lisp_frame.savefn])
2381dnl  __(discard_lisp_frame())
2382dnl  __(bctr)
2383dnl
2384
2385dnl
2386dnl         
2387dnl /* Nargs is valid; all arg regs, lexpr-count pushed by caller.  */
2388dnl /* imm0 = vsp to restore.  */
2389dnl /* Return all values returned by caller to its caller, hiding  */
2390dnl /* the variable-length arglist.  */
2391dnl /* If we can detect that the caller's caller didn't expect  */
2392dnl /* multiple values, then things are even simpler.  */
2393dnl _spentry(lexpr_entry)
2394dnl  __(ref_global(imm1,ret1val_addr))
2395dnl  __(cmpr(imm1,loc_pc))
2396dnl  __(build_lisp_frame(fn,loc_pc,imm0))
2397dnl  __(bne 1f)
2398dnl  __(ref_global(imm0,lexpr_return))
2399dnl  __(build_lisp_frame(rzero,imm0,vsp))
2400dnl  __(mov loc_pc,imm1)
2401dnl  __(ldr imm0,[rcontext,#tcr.cs_limit])
2402dnl  __(trllt(sp,imm0))
2403dnl  __(mov fn,#0)
2404dnl  __(bx lr)
2405dnl
2406dnl         /* The single-value case just needs to return to something that'll pop  */
2407dnl         /* the variable-length frame off of the vstack.  */
2408dnl 1:
2409dnl  __(ref_global(loc_pc,lexpr_return1v))
2410dnl  __(ldr imm0,[rcontext,#tcr.cs_limit])
2411dnl  __(trllt(sp,imm0))
2412dnl  __(mov fn,#0)
2413dnl  __(bx lr)
2414
2415
2416
2417
2418
2419
2420 
2421                 
2422
2423
2424
2425/* Enter the debugger  */
2426_spentry(breakpoint)
2427        __(mov r3,#0)
2428        __(uuo_debug_trap(al))
2429        __(bx lr)  /* if handler didn'*/
2430
2431
2432/* arg_z should be of type (UNSIGNED-BYTE 64);  */
2433/* return high 32 bits in imm1, low 32 bits in imm0 */
2434
2435
2436_spentry(getu64)
2437        __(test_fixnum(arg_z))
2438        __(bne 1f)
2439        __(unbox_fixnum(imm0,arg_z))
2440        __(movs imm1,imm0,asr #31)
2441        __(bxeq lr)
24420:             
2443        __(uuo_error_reg_not_xtype(al,arg_z,xtype_u64))
24441:
2445        __(extract_typecode(imm0,arg_z))
2446        __(cmp imm0,#subtag_bignum)
2447        __(bne 0b)
2448        __(movc16(imm1,two_digit_bignum_header))
2449        __(getvheader(imm0,arg_z))
2450        __(cmp imm0,imm1)
2451        __(bne 2f)
2452        __(vrefr(imm0,arg_z,0))
2453        __(vrefr(imm1,arg_z,1))
2454        __(cmp imm1,#0)
2455        __(bxge lr)
2456        __(uuo_error_reg_not_xtype(al,arg_z,xtype_u64))
24572:      __(movc16(imm1,three_digit_bignum_header))
2458        __(cmp imm0,imm1)
2459        __(uuo_error_reg_not_xtype(ne,arg_z,xtype_u64))
2460        __(vrefr(imm2,arg_z,2))
2461        __(cmp imm2,#0)
2462        __(vrefr(imm1,arg_z,1))
2463        __(vrefr(imm0,arg_z,0))
2464        __(bxeq lr)
2465        __(uuo_error_reg_not_xtype(al,arg_z,xtype_u64))
2466
2467         
2468/* arg_z should be of type (SIGNED-BYTE 64);  */
2469/*    return high 32 bits  in imm1, low 32 bits in imm0  */
2470
2471_spentry(gets64)
2472        __(test_fixnum(arg_z))
2473        __(moveq imm0,arg_z,asr #fixnumshift)
2474        __(moveq imm1,imm0,asr #31)
2475        __(bxeq lr)
2476        __(mov imm2,#0)
2477        __(extract_lisptag(imm0,arg_z))
2478        __(cmp imm0,#tag_misc)
2479        __(ldreq imm2,[arg_z,#misc_header_offset])
2480        __(movc16(imm1,two_digit_bignum_header))
2481        __(cmp imm1,imm2)
2482        __(uuo_error_reg_not_xtype(ne,arg_z,xtype_s64))
2483        __(vrefr(imm1,arg_z,1))
2484        __(vrefr(imm0,arg_z,0))
2485        __(bx lr)
2486
2487
2488/* on entry: arg_z = symbol.  On exit, arg_z = value (possibly */
2489/* unbound_marker), arg_y = symbol, imm1 = symbol.binding-index  */
2490_spentry(specref)
2491        __(ldr imm1,[arg_z,#symbol.binding_index])
2492        __(ldr imm0,[rcontext,#tcr.tlb_limit])
2493        __(cmp imm1,imm0)
2494        __(ldr temp0,[rcontext,#tcr.tlb_pointer])
2495        __(mov arg_y,arg_z)
2496        __(movhs imm1,#0)
2497        __(ldr arg_z,[temp0,imm1])
2498        __(cmp arg_z,#no_thread_local_binding_marker)
2499        __(ldreq arg_z,[arg_y,#symbol.vcell])
2500        __(bx lr)
2501
2502_spentry(specrefcheck)
2503        __(ldr imm1,[arg_z,#symbol.binding_index])
2504        __(ldr imm0,[rcontext,#tcr.tlb_limit])
2505        __(cmp imm1,imm0)
2506        __(movhs imm1,#0)
2507        __(ldr imm0,[rcontext,#tcr.tlb_pointer])
2508        __(mov arg_y,arg_z)
2509        __(ldr arg_z,[imm0,imm1])
2510        __(cmp arg_z,#no_thread_local_binding_marker)
2511        __(ldreq arg_z,[arg_y,#symbol.vcell])
2512        __(cmp arg_z,#unbound_marker)
2513        __(uuo_error_unbound(eq,arg_y))
2514        __(bx lr)
2515
2516/* arg_y = special symbol, arg_z = new value.          */
2517_spentry(specset)
2518        __(ldr imm1,[arg_y,#symbol.binding_index])
2519        __(ldr imm0,[rcontext,#tcr.tlb_limit])
2520        __(ldr imm2,[rcontext,#tcr.tlb_pointer])
2521        __(cmp imm1,imm0)
2522        __(movge imm1,#0)
2523        __(ldr temp1,[imm2,imm1])
2524        __(cmp temp1,#no_thread_local_binding_marker)
2525        __(strne arg_z,[imm2,imm1])
2526        __(bxne lr)
2527        __(mov arg_x,arg_y)
2528        __(mov arg_y,#symbol.vcell-misc_data_offset)
2529        __(b _SPgvset)
2530
2531dnl /* Restore current thread's interrupt level to arg_z, */
2532dnl /* noting whether the tcr's interrupt_pending flag was set.  */
2533dnl _spentry(restoreintlevel)
2534dnl  __(cmpri(cr1,arg_z,0))
2535dnl  __(ldr imm0,[rcontext,#tcr.interrupt_pending])
2536dnl  __(cmpri(imm0,0))
2537dnl  __(bne cr1,1f)
2538dnl  __(beq 1f)
2539dnl  __(str(rzero,tcr.interrupt_pending(rcontext)))
2540dnl  __(mov nargs,#fixnum_one)
2541dnl  __(trgti(nargs,0))
2542dnl  __(bx lr)
2543dnl 1:
2544dnl         __(ldr nargs,[rcontext,#tcr.tlb_pointer])
2545dnl  __(str(arg_z,INTERRUPT_LEVEL_BINDING_INDEX(nargs)))
2546dnl  __(bx lr)
2547
2548       
2549/* Construct a lisp integer out of the 32-bit signed value in imm0 */
2550/* arg_z should be of type (SIGNED-BYTE 32); return unboxed result in imm0 */
2551
2552_spentry(gets32)
2553        __(test_fixnum(arg_z))
2554        __(moveq imm0,arg_z,asr #fixnumshift)
2555        __(bxeq lr)
2556        __(extract_lisptag(imm0,arg_z))
2557        __(cmp imm0,#tag_misc)
2558        __(uuo_error_reg_not_xtype(ne,arg_z,xtype_s32))
2559        __(getvheader(imm0,arg_z))
2560        __(movc16(imm1,one_digit_bignum_header))
2561        __(cmp imm0,imm1)
2562        __(uuo_error_reg_not_xtype(ne,arg_z,xtype_s32))
2563        __(vrefr(imm0,arg_z,0))
2564        __(bx lr)       
2565
2566
2567/*  */
2568/* arg_z should be of type (UNSIGNED-BYTE 32); return unboxed result in imm0 */
2569/*  */
2570
2571 _spentry(getu32)
2572        __(test_fixnum(arg_z))
2573        __(moveq imm0,arg_z,asr #fixnumshift)
2574        __(movseq imm1,imm0,asr #31)
2575        __(bxeq lr)
2576        __(movc16(imm1,one_digit_bignum_header))
2577        __(extract_lisptag(imm0,arg_z))
2578        __(cmp imm0,#tag_misc)
2579        __(uuo_error_reg_not_xtype(ne,arg_z,xtype_u32))
2580        __(getvheader(imm0,arg_z))
2581        __(cmp imm0,imm1)
2582        __(ldreq imm0,[arg_z,#misc_data_offset])
2583        __(beq 7f)
2584        __(movc16(imm1,two_digit_bignum_header))
2585        __(cmp imm0,imm1)
2586        __(ldreq imm0,[arg_z,#misc_data_offset])
2587        __(ldreq imm1,[arg_z,#misc_data_offset+4])
2588        __(cmpeq imm1,#0)
2589        __(bxeq lr)
2590        __(uuo_error_reg_not_xtype(ne,arg_z,xtype_u32))
25917:             
2592        __(movs imm1,imm0,asr #31)
2593        __(bxeq lr)
2594        __(uuo_error_reg_not_xtype(ne,arg_z,xtype_u32))
2595
2596
2597/* */
2598/* As per mvpass above, but in this case fname is known to be a */
2599/* symbol. */
2600
2601_spentry(mvpasssym)
2602        __(cmp nargs,#node_size*nargregs)
2603        __(mov nfn,vsp)
2604        __(subgt nfn,nfn,#node_size*nargregs)
2605        __(addgt nfn,nfn,nargs)
2606        __(build_lisp_frame(imm0,nfn))
2607        __(ref_global(lr,ret1val_addr,imm0))
2608        __(mov fn,#0)
2609        __(jump_fname())
2610
2611_spentry(unbind)
2612        __(ldr imm1,[rcontext,#tcr.db_link])
2613        __(ldr temp0,[rcontext,#tcr.tlb_pointer])   
2614        __(ldr imm0,[imm1,#binding.sym])
2615        __(ldr temp1,[imm1,#binding.val])
2616        __(ldr imm1,[imm1,#binding.link])
2617        __(str temp1,[temp0,imm0])
2618        __(str imm1,[rcontext,#tcr.db_link])
2619        __(bx lr)
2620
2621/* Clobbers imm1,temp0,arg_x, arg_y */       
2622_spentry(unbind_n)
2623        __(ldr imm1,[rcontext,#tcr.db_link])
2624        __(ldr arg_x,[rcontext,#tcr.tlb_pointer])
26251:      __(ldr temp0,[imm1,#binding.sym])
2626        __(ldr arg_y,[imm1,#binding.val])
2627        __(ldr imm1,[imm1,#binding.link])
2628        __(subs imm0,imm0,#1)
2629        __(str arg_y,[arg_x,temp0])
2630        __(bne 1b)
2631        __(str imm1,[rcontext,#tcr.db_link])
2632        __(bx lr)
2633
2634/* */
2635/* Clobbers imm1,temp0,arg_x, arg_y */
2636
2637_spentry(unbind_to)
2638        do_unbind_to(imm1,temp1,arg_x,arg_y)
2639        __(bx lr)
2640 
2641
2642 
2643/* */
2644/* Restore the special bindings from the top of the tstack,  */
2645/* leaving the tstack frame allocated.  */
2646/* Note that there might be 0 saved bindings, in which case  */
2647/* do nothing.  */
2648/* Note also that this is -only- called from an unwind-protect  */
2649/* cleanup form, and that .SPnthrowXXX is keeping one or more  */
2650/* values in a frame on top of the tstack.  */
2651/*  */
2652                         
2653_spentry(progvrestore)
2654        __(skip_stack_vector(imm0,imm1,sp))
2655        /* There might be a lisp_frame at imm0.  Not sure */
2656        __(ldr imm0,[imm0,#node_size]) /* or maybe node_size+lisp_frame.size */
2657        __(cmp imm0,#0)
2658        __(unbox_fixnum(imm0,imm0))
2659        __(bne _SPunbind_n)
2660        __(bx lr)
2661
2662/* Bind CCL::*INTERRUPT-LEVEL* to 0.  If its value had been negative, check  */
2663/* for pending interrupts after doing so.  */
2664_spentry(bind_interrupt_level_0)
2665        __(ldr temp1,[rcontext,#tcr.tlb_pointer])
2666        __(ldr temp0,[temp1,#INTERRUPT_LEVEL_BINDING_INDEX])
2667        __(ldr imm0,[rcontext,#tcr.db_link])
2668        __(cmp temp0,#0)
2669        __(mov imm1,#INTERRUPT_LEVEL_BINDING_INDEX)
2670        __(vpush1(temp0))
2671        __(vpush1(imm1))
2672        __(vpush1(imm0))
2673        __(mov imm0,#0)
2674        __(str imm0,[temp1,#INTERRUPT_LEVEL_BINDING_INDEX])
2675        __(str vsp,[rcontext,#tcr.db_link])
2676        __(bxeq lr)
2677        __(ldrlt temp0,[rcontext,#tcr.interrupt_pending])
2678        __(cmp temp0,#0)
2679        __(uuo_interrupt_now(gt))
2680        __(bx lr)
2681       
2682/* Bind CCL::*INTERRUPT-LEVEL* to the fixnum -1.  (This has the effect */
2683/* of disabling interrupts.)  */
2684_spentry(bind_interrupt_level_m1)
2685        __(mov imm2,#-fixnumone)
2686        __(mov imm1,#INTERRUPT_LEVEL_BINDING_INDEX)
2687        __(ldr temp1,[rcontext,#tcr.tlb_pointer])
2688        __(ldr temp0,[temp1,#INTERRUPT_LEVEL_BINDING_INDEX])
2689        __(ldr imm0,[rcontext,#tcr.db_link])
2690        __(vpush1(temp0))
2691        __(vpush1(imm1))
2692        __(vpush1(imm0))
2693        __(str imm2,[temp1,#INTERRUPT_LEVEL_BINDING_INDEX])
2694        __(str vsp,[rcontext,tcr.db_link])
2695        __(bx lr)
2696       
2697
2698/* Bind CCL::*INTERRUPT-LEVEL* to the value in arg_z.  If that value's 0, */
2699/* do what _SPbind_interrupt_level_0 does  */
2700_spentry(bind_interrupt_level)
2701        __(cmp arg_z,#0)
2702        __(mov imm1,#INTERRUPT_LEVEL_BINDING_INDEX)
2703        __(ldr temp1,[rcontext,#tcr.tlb_pointer])
2704        __(ldr temp0,[temp1,#INTERRUPT_LEVEL_BINDING_INDEX])
2705        __(ldr imm0,[rcontext,#tcr.db_link])
2706        __(beq _SPbind_interrupt_level_0)
2707        __(vpush1(temp0))
2708        __(vpush1(imm1))
2709        __(vpush1(imm0))
2710        __(str arg_z,[temp1,INTERRUPT_LEVEL_BINDING_INDEX])
2711        __(str vsp,[rcontext,#tcr.db_link])
2712        __(bx lr)
2713
2714/* Unbind CCL::*INTERRUPT-LEVEL*.  If the value changes from negative to */
2715/* non-negative, check for pending interrupts.  This is often called in */
2716/* a context where nargs is significant, so save and restore nargs around */
2717/* any interrupt polling  */
2718         
2719 _spentry(unbind_interrupt_level)
2720        __(ldr imm0,[rcontext,#tcr.flags])
2721        __(ldr temp2,[rcontext,#tcr.tlb_pointer])
2722        __(tst imm0,#1<<TCR_FLAG_BIT_PENDING_SUSPEND)
2723        __(ldr imm0,[rcontext,#tcr.db_link])
2724        __(ldr temp0,[temp2,#INTERRUPT_LEVEL_BINDING_INDEX])
2725        __(bne 5f)
27260:     
2727        __(ldr temp1,[imm0,#binding.val])
2728        __(ldr imm0,[imm0,#binding.link])
2729        __(str temp1,[temp2,#INTERRUPT_LEVEL_BINDING_INDEX])
2730        __(str imm0,[rcontext,#tcr.db_link])
2731        __(cmp temp0,#0)
2732        __(bxge lr)
2733        __(cmp temp1,#0)
2734        __(bxlt lr)
2735        __(check_enabled_pending_interrupt(imm0))
2736        __(bx lr)
27375:       /* Missed a suspend request; force suspend now if we're restoring
2738          interrupt level to -1 or greater */
2739        __(cmp temp0,#-2<<fixnumshift)
2740        __(bne 0b)
2741        __(ldr imm0,[imm1,#binding.val])
2742        __(cmp imm0,temp0)
2743        __(beq 0b)
2744        __(mov imm0,#1<<fixnumshift)
2745        __(str imm0,[temp2,INTERRUPT_LEVEL_BINDING_INDEX])
2746        __(suspend_now())
2747        __(b 0b)
2748 
2749 
2750/* arg_x = array, arg_y = i, arg_z = j. Typecheck everything.
2751    We don't know whether the array is alleged to be simple or
2752   not, and don't know anythng about the element type.  */
2753_spentry(aref2)
2754        __(trap_unless_fixnum(arg_y))
2755        __(trap_unless_fixnum(arg_z))
2756        __(extract_typecode(imm2,arg_x))
2757        __(cmp imm2,#subtag_arrayH)
2758        __(ldreq imm1,[arg_x,#arrayH.rank])
2759        __(cmpeq imm1,#2<<fixnumshift)
2760        __(uuo_error_reg_not_xtype(ne,arg_x,xtype_array2d))
2761        /* It's a 2-dimensional array.  Check bounds */
2762        __(ldr imm0,[arg_x,#arrayH.dim0])
2763        __(cmp arg_y,imm0)
2764        __(uuo_error_array_bounds(hs,arg_y,arg_x))
2765        __(ldr imm0,[arg_x,#arrayH.dim0+node_size])
2766        __(cmp arg_z,imm0)
2767        __(uuo_error_array_bounds(hs,arg_z,arg_x))
2768        __(unbox_fixnum(imm0,imm0))
2769        __(mul temp0,arg_y,imm0) /* no MLA on ARMv5 */
2770        __(add arg_z,arg_z,temp0)
2771        /* arg_z is now row-major-index; get data vector and
2772           add in possible offset */
2773        __(mov arg_y,arg_x)
27740:      __(ldr imm0,[arg_y,#arrayH.displacement])
2775        __(ldr arg_y,[arg_y,#arrayH.data_vector])
2776        __(extract_subtag(imm1,arg_y))
2777        __(cmp imm1,#subtag_vectorH)
2778        __(add arg_z,arg_z,imm0)
2779        __(bgt C(misc_ref_common))
2780        __(b 0b)
2781 
2782/* temp0 = array, arg_x = i, arg_y = j, arg_z = k */
2783_spentry(aref3)
2784        __(trap_unless_fixnum(arg_x))
2785        __(trap_unless_fixnum(arg_y))
2786        __(trap_unless_fixnum(arg_z))
2787        __(extract_typecode(imm2,temp0))
2788        __(mov imm1,#0)
2789        __(cmp imm2,#subtag_arrayH)
2790        __(ldreq imm1,[temp0,#arrayH.rank])
2791        __(cmp imm1,#3<<fixnumshift)
2792        __(uuo_error_reg_not_xtype(ne,temp0,xtype_array3d))
2793        /* It's a 3-dimensional array.  Check bounds */
2794        __(ldr imm2,[temp0,arrayH.dim0+(node_size*2)])
2795        __(ldr imm1,[temp0,#arrayH.dim0+node_size])
2796        __(ldr imm0,[temp0,#arrayH.dim0])
2797        __(cmp arg_z,imm2)
2798        __(uuo_error_array_bounds(hs,arg_z,temp0))
2799        __(cmp arg_y,imm1)
2800        __(uuo_error_array_bounds(hs,arg_y,temp0))
2801        __(cmp arg_x,imm0)
2802        __(uuo_error_array_bounds(hs,arg_x,temp0))
2803        __(unbox_fixnum(imm2,imm2))
2804        __(unbox_fixnum(imm1,imm1))
2805        __(mul arg_y,imm2,arg_y)
2806        __(mul imm1,imm2,imm1)
2807        __(mul arg_x,imm1,arg_x)
2808        __(add arg_z,arg_z,arg_y)
2809        __(add arg_z,arg_z,arg_x)
2810        __(mov arg_y,temp0)
28110:      __(ldr arg_x,[arg_y,#arrayH.displacement])
2812        __(ldr arg_y,[arg_y,#arrayH.data_vector])
2813        __(extract_subtag(imm1,arg_y))
2814        __(cmp imm1,#subtag_vectorH)
2815        __(add arg_z,arg_x,arg_z)
2816        __(bgt C(misc_ref_common))
2817        __(b 0b)
2818
2819
2820
2821
2822/* As for aref2 above, but temp = array, arg_x = i, arg_y = j, arg_z = newval */
2823_spentry(aset2)
2824        __(extract_typecode(imm0,temp0))
2825        __(cmp imm0,#subtag_arrayH)
2826        __(ldreq imm0,[temp0,#arrayH.rank])
2827        __(cmpeq imm0,#2<<fixnumshift)
2828        __(uuo_error_reg_not_xtype(ne,temp0,xtype_array2d))
2829        __(trap_unless_fixnum(arg_x))
2830        __(trap_unless_fixnum(arg_y))
2831        /* It's a 2-dimensional array.  Check bounds */
2832        __(ldr imm0,[temp0,#arrayH.dim0])
2833        __(cmp arg_x,imm0)
2834        __(uuo_error_array_bounds(hs,arg_x,temp0))
2835        __(ldr imm0,[temp0,#arrayH.dim0+node_size])
2836        __(cmp arg_y,imm0)
2837        __(uuo_error_array_bounds(hs,arg_y,temp0))
2838        __(unbox_fixnum(imm0,imm0))
2839        __(mul temp1,arg_x,imm0)
2840        __(add arg_y,arg_y,temp1)
2841        /* arg_y is now row-major-index; get data vector and
2842           add in possible offset */
2843        __(mov arg_x,temp0)
28440:      __(ldr imm0,[arg_x,#arrayH.displacement])
2845        __(ldr arg_x,[arg_x,#arrayH.data_vector])
2846        __(extract_subtag(imm1,arg_x))
2847        __(cmp imm1,#subtag_vectorH)
2848        __(add arg_y,arg_y,imm0)
2849        __(bgt C(misc_set_common))
2850        __(b 0b)
2851
2852                 
2853/* temp1 = array, temp0 = i, arg_x = j, arg_y = k, arg_z = new */       
2854_spentry(aset3)
2855        __(extract_typecode(imm0,temp1))
2856        __(cmp imm0,#subtag_arrayH)
2857        __(ldreq imm0,[temp1,#arrayH.rank])
2858        __(cmpeq imm0,#3<<fixnumshift)
2859        __(uuo_error_reg_not_xtype(ne,temp1,xtype_array3d))
2860        __(trap_unless_fixnum(temp0))
2861        __(trap_unless_fixnum(arg_x))
2862        __(trap_unless_fixnum(arg_y))
2863        /* It's a 3-dimensional array.  Check bounds */
2864        __(ldr imm2,[temp1,#arrayH.dim0+(node_size*2)])
2865        __(ldr imm1,[temp1,#arrayH.dim0+node_size])
2866        __(ldr imm0,[temp1,#arrayH.dim0])
2867        __(cmp arg_y,imm2)
2868        __(uuo_error_array_bounds(hs,arg_y,temp1))
2869        __(cmp arg_x,imm1)
2870        __(uuo_error_array_bounds(hs,arg_x,temp1))
2871        __(unbox_fixnum(imm1,imm1))
2872        __(cmp temp0,imm0)
2873        __(uuo_error_array_bounds(hs,temp0,temp1))
2874        __(mul arg_x,imm2,arg_x)
2875        __(mul imm1,imm2,imm1)
2876        __(mul temp0,imm1,temp0)
2877        __(add arg_y,arg_y,arg_x)
2878        __(add arg_y,arg_y,temp0)
2879        __(mov arg_x,temp1)
28800:      __(ldr temp0,[arg_x,#arrayH.displacement])
2881        __(ldr arg_x,[arg_x,#arrayH.data_vector])
2882        __(extract_subtag(imm1,arg_x))
2883        __(cmp imm1,#subtag_vectorH)
2884        __(add arg_y,arg_y,temp0)
2885        __(bgt C(misc_set_common))
2886        __(b 0b)
2887
2888
2889_spentry(nmkunwind)
2890        __(mov imm2,#-fixnumone)
2891        __(mov imm1,#INTERRUPT_LEVEL_BINDING_INDEX)
2892        __(ldr temp0,[rcontext,#tcr.tlb_pointer])
2893        __(ldr arg_y,[temp0,#INTERRUPT_LEVEL_BINDING_INDEX])
2894        __(ldr imm0,[rcontext,#tcr.db_link])
2895        __(vpush1(arg_y))
2896        __(vpush1(imm1))
2897        __(vpush1(imm0))
2898        __(str imm2,[temp0,#INTERRUPT_LEVEL_BINDING_INDEX])
2899        __(str vsp,[rcontext,#tcr.db_link])
2900        __(mov arg_z,#unbound_marker)
2901        __(mov imm2,#fixnum_one)
2902        __(mkcatch())
2903        __(mov arg_z,arg_y)
2904        __(b _SPbind_interrupt_level)
2905
2906/*  EOF, basically  */
2907       
2908_exportfn(C(misc_ref_common))
2909        __(adr imm0,(local_label(misc_ref_jmp)))
2910        __(ldr pc,[imm0,imm1,lsl #2])       
2911
2912local_label(misc_ref_jmp):         
2913        /* 00-0*/
2914        .long local_label(misc_ref_invalid) /* 00 even_fixnum  */
2915       
2916        .long local_label(misc_ref_invalid) /* 01 cons  */
2917        .long local_label(misc_ref_invalid) /* 02 nodeheader  */
2918        .long local_label(misc_ref_invalid) /* 03 imm  */
2919        .long local_label(misc_ref_invalid) /* 04 odd_fixnum  */
2920        .long local_label(misc_ref_invalid) /* 05 nil  */
2921        .long local_label(misc_ref_invalid) /* 06 misc  */
2922        .long local_label(misc_ref_u32) /* 07 bignum  */
2923        .long local_label(misc_ref_invalid) /* 08 even_fixnum  */
2924        .long local_label(misc_ref_invalid) /* 09 cons  */
2925        .long local_label(misc_ref_node) /* 0a ratio  */
2926        .long local_label(misc_ref_invalid) /* 0b imm  */
2927        .long local_label(misc_ref_invalid) /* 0c odd_fixnum  */
2928        .long local_label(misc_ref_invalid) /* 0d nil  */
2929        .long local_label(misc_ref_invalid) /* 0e misc  */
2930        .long local_label(misc_ref_u32) /* 0f single_float  */
2931        /* 10-1*/
2932        .long local_label(misc_ref_invalid) /* 10 even_fixnum  */
2933        .long local_label(misc_ref_invalid) /* 11 cons  */
2934        .long local_label(misc_ref_invalid) /* 12 nodeheader  */
2935        .long local_label(misc_ref_invalid) /* 13 imm  */
2936        .long local_label(misc_ref_invalid) /* 14 odd_fixnum  */
2937        .long local_label(misc_ref_invalid) /* 15 nil  */
2938        .long local_label(misc_ref_invalid) /* 16 misc  */
2939        .long local_label(misc_ref_u32) /* 17 double_float  */
2940        .long local_label(misc_ref_invalid) /* 18 even_fixnum  */
2941        .long local_label(misc_ref_invalid) /* 19 cons  */
2942        .long local_label(misc_ref_node) /* 1a complex  */
2943        .long local_label(misc_ref_invalid) /* 1b imm  */
2944        .long local_label(misc_ref_invalid) /* 1c odd_fixnum  */
2945        .long local_label(misc_ref_invalid) /* 1d nil  */
2946        .long local_label(misc_ref_invalid) /* 1e misc  */
2947        .long local_label(misc_ref_u32) /* 1f macptr  */
2948        /* 20-2*/
2949        .long local_label(misc_ref_invalid) /* 20 even_fixnum  */
2950        .long local_label(misc_ref_invalid) /* 21 cons  */
2951        .long local_label(misc_ref_node) /* 22 catch_frame  */
2952        .long local_label(misc_ref_invalid) /* 23 imm  */
2953        .long local_label(misc_ref_invalid) /* 24 odd_fixnum  */
2954        .long local_label(misc_ref_invalid) /* 25 nil  */
2955        .long local_label(misc_ref_invalid) /* 26 misc  */
2956        .long local_label(misc_ref_u32) /* 27 dead_macptr  */
2957        .long local_label(misc_ref_invalid) /* 28 even_fixnum  */
2958        .long local_label(misc_ref_invalid) /* 29 cons  */
2959        .long local_label(misc_ref_node) /* 2a function  */
2960        .long local_label(misc_ref_invalid) /* 2b imm  */
2961        .long local_label(misc_ref_invalid) /* 2c odd_fixnum  */
2962        .long local_label(misc_ref_invalid) /* 2d nil  */
2963        .long local_label(misc_ref_invalid) /* 2e misc  */
2964        .long local_label(misc_ref_u32) /* 2f code_vector  */
2965        /* 30-3*/
2966        .long local_label(misc_ref_invalid) /* 30 even_fixnum  */
2967        .long local_label(misc_ref_invalid) /* 31 cons  */
2968        .long local_label(misc_ref_node) /* 32 lisp_thread  */
2969        .long local_label(misc_ref_invalid) /* 33 imm  */
2970        .long local_label(misc_ref_invalid) /* 34 odd_fixnum  */
2971        .long local_label(misc_ref_invalid) /* 35 nil  */
2972        .long local_label(misc_ref_invalid) /* 36 misc  */
2973        .long local_label(misc_ref_u32) /* 37 creole  */
2974        .long local_label(misc_ref_invalid) /* 38 even_fixnum  */
2975        .long local_label(misc_ref_invalid) /* 39 cons  */
2976        .long local_label(misc_ref_node) /* 3a symbol  */
2977        .long local_label(misc_ref_invalid) /* 3b imm  */
2978        .long local_label(misc_ref_invalid) /* 3c odd_fixnum  */
2979        .long local_label(misc_ref_invalid) /* 3d nil  */
2980        .long local_label(misc_ref_invalid) /* 3e misc  */
2981        .long local_label(misc_ref_u32) /* 3f xcode_vector  */
2982        /* 40-4*/
2983        .long local_label(misc_ref_invalid) /* 40 even_fixnum  */
2984        .long local_label(misc_ref_invalid) /* 41 cons  */
2985        .long local_label(misc_ref_node) /* 42 lock  */
2986        .long local_label(misc_ref_invalid) /* 43 imm  */
2987        .long local_label(misc_ref_invalid) /* 44 odd_fixnum  */
2988        .long local_label(misc_ref_invalid) /* 45 nil  */
2989        .long local_label(misc_ref_invalid) /* 46 misc  */
2990        .long local_label(misc_ref_invalid) /* 47 immheader  */
2991        .long local_label(misc_ref_invalid) /* 48 even_fixnum  */
2992        .long local_label(misc_ref_invalid) /* 49 cons  */
2993        .long local_label(misc_ref_node) /* 4a hash_vector  */
2994        .long local_label(misc_ref_invalid) /* 4b imm  */
2995        .long local_label(misc_ref_invalid) /* 4c odd_fixnum  */
2996        .long local_label(misc_ref_invalid) /* 4d nil  */
2997        .long local_label(misc_ref_invalid) /* 4e misc  */
2998        .long local_label(misc_ref_invalid) /* 4f immheader  */
2999        /* 50-5*/
3000        .long local_label(misc_ref_invalid) /* 50 even_fixnum  */
3001        .long local_label(misc_ref_invalid) /* 51 cons  */
3002        .long local_label(misc_ref_node) /* 52 pool  */
3003        .long local_label(misc_ref_invalid) /* 53 imm  */
3004        .long local_label(misc_ref_invalid) /* 54 odd_fixnum  */
3005        .long local_label(misc_ref_invalid) /* 55 nil  */
3006        .long local_label(misc_ref_invalid) /* 56 misc  */
3007        .long local_label(misc_ref_invalid) /* 57 immheader  */
3008        .long local_label(misc_ref_invalid) /* 58 even_fixnum  */
3009        .long local_label(misc_ref_invalid) /* 59 cons  */
3010        .long local_label(misc_ref_node) /* 5a weak  */
3011        .long local_label(misc_ref_invalid) /* 5b imm  */
3012        .long local_label(misc_ref_invalid) /* 5c odd_fixnum  */
3013        .long local_label(misc_ref_invalid) /* 5d nil  */
3014        .long local_label(misc_ref_invalid) /* 5e misc  */
3015        .long local_label(misc_ref_invalid) /* 5f immheader  */
3016        /* 60-6*/
3017        .long local_label(misc_ref_invalid) /* 60 even_fixnum  */
3018        .long local_label(misc_ref_invalid) /* 61 cons  */
3019        .long local_label(misc_ref_node) /* 62 package  */
3020        .long local_label(misc_ref_invalid) /* 63 imm  */
3021        .long local_label(misc_ref_invalid) /* 64 odd_fixnum  */
3022        .long local_label(misc_ref_invalid) /* 65 nil  */
3023        .long local_label(misc_ref_invalid) /* 66 misc  */
3024        .long local_label(misc_ref_invalid) /* 67 immheader  */
3025        .long local_label(misc_ref_invalid) /* 68 even_fixnum  */
3026        .long local_label(misc_ref_invalid) /* 69 cons  */
3027        .long local_label(misc_ref_node) /* 6a slot_vector  */
3028        .long local_label(misc_ref_invalid) /* 6b imm  */
3029        .long local_label(misc_ref_invalid) /* 6c odd_fixnum  */
3030        .long local_label(misc_ref_invalid) /* 6d nil  */
3031        .long local_label(misc_ref_invalid) /* 6e misc  */
3032        .long local_label(misc_ref_invalid) /* 6f immheader  */
3033        /* 70-7*/
3034        .long local_label(misc_ref_invalid) /* 70 even_fixnum  */
3035        .long local_label(misc_ref_invalid) /* 71 cons  */
3036        .long local_label(misc_ref_node) /* 72 instance  */
3037        .long local_label(misc_ref_invalid) /* 73 imm  */
3038        .long local_label(misc_ref_invalid) /* 74 odd_fixnum  */
3039        .long local_label(misc_ref_invalid) /* 75 nil  */
3040        .long local_label(misc_ref_invalid) /* 76 misc  */
3041        .long local_label(misc_ref_invalid) /* 77 immheader  */
3042        .long local_label(misc_ref_invalid) /* 78 even_fixnum  */
3043        .long local_label(misc_ref_invalid) /* 79 cons  */
3044        .long local_label(misc_ref_node) /* 7a struct  */
3045        .long local_label(misc_ref_invalid) /* 7b imm  */
3046        .long local_label(misc_ref_invalid) /* 7c odd_fixnum  */
3047        .long local_label(misc_ref_invalid) /* 7d nil  */
3048        .long local_label(misc_ref_invalid) /* 7e misc  */
3049        .long local_label(misc_ref_invalid) /* 7f immheader  */
3050        /* 80-8*/
3051        .long local_label(misc_ref_invalid) /* 80 even_fixnum  */
3052        .long local_label(misc_ref_invalid) /* 81 cons  */
3053        .long local_label(misc_ref_node) /* 82 istruct  */
3054        .long local_label(misc_ref_invalid) /* 83 imm  */
3055        .long local_label(misc_ref_invalid) /* 84 odd_fixnum  */
3056        .long local_label(misc_ref_invalid) /* 85 nil  */
3057        .long local_label(misc_ref_invalid) /* 86 misc  */
3058        .long local_label(misc_ref_invalid) /* 87 immheader  */
3059        .long local_label(misc_ref_invalid) /* 88 even_fixnum  */
3060        .long local_label(misc_ref_invalid) /* 89 cons  */
3061        .long local_label(misc_ref_node) /* 8a value_cell  */
3062        .long local_label(misc_ref_invalid) /* 8b imm  */
3063        .long local_label(misc_ref_invalid) /* 8c odd_fixnum  */
3064        .long local_label(misc_ref_invalid) /* 8d nil  */
3065        .long local_label(misc_ref_invalid) /* 8e misc  */
3066        .long local_label(misc_ref_invalid) /* 8f immheader  */
3067        /* 90-9*/
3068        .long local_label(misc_ref_invalid) /* 90 even_fixnum  */
3069        .long local_label(misc_ref_invalid) /* 91 cons  */
3070        .long local_label(misc_ref_node) /* 92 xfunction  */
3071        .long local_label(misc_ref_invalid) /* 93 imm  */
3072        .long local_label(misc_ref_invalid) /* 94 odd_fixnum  */
3073        .long local_label(misc_ref_invalid) /* 95 nil  */
3074        .long local_label(misc_ref_invalid) /* 96 misc  */
3075        .long local_label(misc_ref_invalid) /* 97 immheader  */
3076        .long local_label(misc_ref_invalid) /* 98 even_fixnum  */
3077        .long local_label(misc_ref_invalid) /* 99 cons  */
3078        .long local_label(misc_ref_node) /* 9a arrayN  */
3079        .long local_label(misc_ref_invalid) /* 9b imm  */
3080        .long local_label(misc_ref_invalid) /* 9c odd_fixnum  */
3081        .long local_label(misc_ref_invalid) /* 9d nil  */
3082        .long local_label(misc_ref_invalid) /* 9e misc  */
3083        .long local_label(misc_ref_invalid) /* 9f immheader  */
3084        /* a0-af  */
3085        .long local_label(misc_ref_invalid) /* a0 even_fixnum  */
3086        .long local_label(misc_ref_invalid) /* a1 cons  */
3087        .long local_label(misc_ref_node) /* a2 vectorH  */
3088        .long local_label(misc_ref_invalid) /* a3 imm  */
3089        .long local_label(misc_ref_invalid) /* a4 odd_fixnum  */
3090        .long local_label(misc_ref_invalid) /* a5 nil  */
3091        .long local_label(misc_ref_invalid) /* a6 misc  */
3092        .long local_label(misc_ref_single_float_vector) /* a7 sf_vector  */
3093        .long local_label(misc_ref_invalid) /* a8 even_fixnum  */
3094        .long local_label(misc_ref_invalid) /* a9 cons  */
3095        .long local_label(misc_ref_node) /* aa simple_vector  */
3096        .long local_label(misc_ref_invalid) /* ab imm  */
3097        .long local_label(misc_ref_invalid) /* ac odd_fixnum  */
3098        .long local_label(misc_ref_invalid) /* ad nil  */
3099        .long local_label(misc_ref_invalid) /* ae misc  */
3100        .long local_label(misc_ref_u32) /* af u32  */
3101        /* b0-bf  */
3102        .long local_label(misc_ref_invalid) /* b0 even_fixnum  */
3103        .long local_label(misc_ref_invalid) /* b1 cons  */
3104        .long local_label(misc_ref_invalid) /* b2 nodeheader  */
3105        .long local_label(misc_ref_invalid) /* b3 imm  */
3106        .long local_label(misc_ref_invalid) /* b4 odd_fixnum  */
3107        .long local_label(misc_ref_invalid) /* b5 nil  */
3108        .long local_label(misc_ref_invalid) /* b6 misc  */
3109        .long local_label(misc_ref_s32) /* b7 s32  */
3110        .long local_label(misc_ref_invalid) /* b8 even_fixnum  */
3111        .long local_label(misc_ref_invalid) /* b9 cons  */
3112        .long local_label(misc_ref_invalid) /* ba nodeheader  */
3113        .long local_label(misc_ref_invalid) /* bb imm  */
3114        .long local_label(misc_ref_invalid) /* bc odd_fixnum  */
3115        .long local_label(misc_ref_invalid) /* bd nil  */
3116        .long local_label(misc_ref_invalid) /* be misc  */
3117        .long local_label(misc_ref_fixnum_vector) /* bf fixnum_vector  */
3118        /* c0-cf  */
3119        .long local_label(misc_ref_invalid) /* c0 even_fixnum  */
3120        .long local_label(misc_ref_invalid) /* c1 cons  */
3121        .long local_label(misc_ref_invalid) /* c2 nodeheader  */
3122        .long local_label(misc_ref_invalid) /* c3 imm  */
3123        .long local_label(misc_ref_invalid) /* c4 odd_fixnum  */
3124        .long local_label(misc_ref_invalid) /* c5 nil  */
3125        .long local_label(misc_ref_invalid) /* c6 misc  */
3126        .long local_label(misc_ref_new_string) /* c7 new_string  */
3127        .long local_label(misc_ref_invalid) /* c8 even_fixnum  */
3128        .long local_label(misc_ref_invalid) /* c9 cons  */
3129        .long local_label(misc_ref_invalid) /* ca nodeheader  */
3130        .long local_label(misc_ref_invalid) /* cb imm  */
3131        .long local_label(misc_ref_invalid) /* cc odd_fixnum  */
3132        .long local_label(misc_ref_invalid) /* cd nil  */
3133        .long local_label(misc_ref_invalid) /* ce misc  */
3134        .long local_label(misc_ref_u8) /* cf u8  */
3135        /* d0-df  */
3136        .long local_label(misc_ref_invalid) /* d0 even_fixnum  */
3137        .long local_label(misc_ref_invalid) /* d1 cons  */
3138        .long local_label(misc_ref_invalid) /* d2 nodeheader  */
3139        .long local_label(misc_ref_invalid) /* d3 imm  */
3140        .long local_label(misc_ref_invalid) /* d4 odd_fixnum  */
3141        .long local_label(misc_ref_invalid) /* d5 nil  */
3142        .long local_label(misc_ref_invalid) /* d6 misc  */
3143        .long local_label(misc_ref_s8)      /* d7 s8  */
3144        .long local_label(misc_ref_invalid) /* d8 even_fixnum  */
3145        .long local_label(misc_ref_invalid) /* d9 cons  */
3146        .long local_label(misc_ref_invalid) /* da nodeheader  */
3147        .long local_label(misc_ref_invalid) /* db imm  */
3148        .long local_label(misc_ref_invalid) /* dc odd_fixnum  */
3149        .long local_label(misc_ref_invalid) /* dd nil  */
3150        .long local_label(misc_ref_invalid) /* de misc  */
3151        .long local_label(misc_ref_old_string) /* df (old)subtag_simple_base_string  */
3152        /* e0-ef  */
3153        .long local_label(misc_ref_invalid) /* e0 even_fixnum  */
3154        .long local_label(misc_ref_invalid) /* e1 cons  */
3155        .long local_label(misc_ref_invalid) /* e2 nodeheader  */
3156        .long local_label(misc_ref_invalid) /* e3 imm  */
3157        .long local_label(misc_ref_invalid) /* e4 odd_fixnum  */
3158        .long local_label(misc_ref_invalid) /* e5 nil  */
3159        .long local_label(misc_ref_invalid) /* e6 misc  */
3160        .long local_label(misc_ref_u16) /* e7 u16  */
3161        .long local_label(misc_ref_invalid) /* e8 even_fixnum  */
3162        .long local_label(misc_ref_invalid) /* e9 cons  */
3163        .long local_label(misc_ref_invalid) /* ea nodeheader  */
3164        .long local_label(misc_ref_invalid) /* eb imm  */
3165        .long local_label(misc_ref_invalid) /* ec odd_fixnum  */
3166        .long local_label(misc_ref_invalid) /* ed nil  */
3167        .long local_label(misc_ref_invalid) /* ee misc  */
3168        .long local_label(misc_ref_s16) /* ef s16  */
3169        /* f0-ff  */
3170        .long local_label(misc_ref_invalid) /* f0 even_fixnum  */
3171        .long local_label(misc_ref_invalid) /* f1 cons  */
3172        .long local_label(misc_ref_invalid) /* f2 nodeheader  */
3173        .long local_label(misc_ref_invalid) /* f3 imm  */
3174        .long local_label(misc_ref_invalid) /* f4 odd_fixnum  */
3175        .long local_label(misc_ref_invalid) /* f5 nil  */
3176        .long local_label(misc_ref_invalid) /* f6 misc  */
3177        .long local_label(misc_ref_double_float_vector) /* f7 df vector  */
3178        .long local_label(misc_ref_invalid) /* f8 even_fixnum  */
3179        .long local_label(misc_ref_invalid) /* f9 cons  */
3180        .long local_label(misc_ref_invalid) /* fa nodeheader  */
3181        .long local_label(misc_ref_invalid) /* fb imm  */
3182        .long local_label(misc_ref_invalid) /* fc odd_fixnum  */
3183        .long local_label(misc_ref_invalid) /* fd nil  */
3184        .long local_label(misc_ref_invalid) /* fe misc  */
3185        .long local_label(misc_ref_bit_vector) /* ff bit_vector  */
3186
3187local_label(misc_ref_node):       
3188        /* A node vector.  */
3189        __(add imm0,arg_z,#misc_data_offset)
3190        __(ldr  arg_z,[arg_y,imm0])
3191        __(bx lr)
3192local_label(misc_ref_single_float_vector):       
3193        __(add imm0,arg_z,misc_data_offset)
3194        __(movc16(imm1,single_float_header))
3195        __(ldr imm0,[arg_y,imm0])
3196        __(Misc_Alloc_Fixed(arg_z,imm1,single_float.size))
3197        __(str imm0,[arg_z,#single_float.value])
3198        __(bx lr)
3199local_label(misc_ref_new_string):       
3200        __(add imm0,arg_z,#misc_data_offset)
3201        __(ldr imm0,[arg_y,imm0])
3202        __(mov arg_z,imm0,lsl #charcode_shift)
3203        __(orr arg_z,arg_z,#subtag_character)
3204        __(bx lr)
3205local_label(misc_ref_s32):       
3206        __(add imm0,arg_z,#misc_data_offset)
3207        __(ldr imm0,[arg_y,imm0])
3208        __(b _SPmakes32)
3209local_label(misc_ref_fixnum_vector):   
3210        __(add imm0,arg_z,#misc_data_offset)
3211        __(ldr imm0,[arg_y,imm0])
3212        __(box_fixnum(arg_z,imm0))
3213        __(bx lr)       
3214local_label(misc_ref_u32):       
3215        __(add imm0,arg_z,#misc_data_offset)
3216        __(ldr imm0,[arg_y,imm0])
3217        __(b _SPmakeu32)
3218local_label(misc_ref_double_float_vector):     
3219        __(mov imm0,arg_z,lsl #1)
3220        __(add imm0,imm0,#misc_dfloat_offset)
3221        __(ldrd imm0,imm1,[arg_y,imm0])
3222        __(movc16(imm2,double_float_header))
3223        __(Misc_Alloc_Fixed(arg_z,imm2,double_float.size))
3224        __(strd imm0,imm1,[arg_z,#double_float.value])
3225        __(bx lr)
3226local_label(misc_ref_bit_vector):
3227        __(mov imm1,#nbits_in_word-1)
3228        __(and imm1,imm1,arg_z,lsr #2)
3229        __(mov imm2,#1)
3230        __(mov imm2,imm2,lsl imm1)
3231        __(mov imm0,arg_z,lsr #5+fixnumshift)
3232        __(mov imm0,imm0,lsl #2)
3233        __(add imm0,imm0,#misc_data_offset)
3234        __(mov arg_z,#0)
3235        __(ldr imm0,[arg_y,imm0])
3236        __(tst imm0,imm2)
3237        __(addne arg_z,arg_z,#fixnumone)
3238        __(bx lr)
3239local_label(misc_ref_s8):       
3240        __(mov imm0,arg_z,lsr #2)
3241        __(add imm0,imm0,#misc_data_offset)
3242        __(ldsb imm0,[arg_y,imm0])
3243        __(box_fixnum(arg_z,imm0))
3244        __(bx lr)
3245local_label(misc_ref_u8):       
3246        __(mov imm0,arg_z,lsr #2)
3247        __(add imm0,imm0,#misc_data_offset)
3248        __(ldrb imm0,[arg_y,imm0])
3249        __(box_fixnum(arg_z,imm0))
3250        __(bx lr)
3251local_label(misc_ref_old_string):         
3252        __(mov imm0,arg_z,lsr #2)
3253        __(add imm0,imm0,#misc_data_offset)
3254        __(ldrb imm0,[arg_y,imm0])
3255        __(mov arg_z,imm0,lsl #charcode_shift)
3256        __(orr arg_z,arg_z,#subtag_character)
3257        __(bx lr)
3258local_label(misc_ref_u16):       
3259        __(mov imm0,arg_z,lsr #1)     
3260        __(add imm0,imm0,#misc_data_offset)
3261        __(ldrh imm0,[arg_y,imm0])
3262        __(box_fixnum(arg_z,imm0))
3263        __(bx lr)
3264local_label(misc_ref_s16):             
3265        __(mov imm0,arg_z,lsr #1)     
3266        __(add imm0,imm0,#misc_data_offset)
3267        __(ldrsh imm0,[arg_y,imm0])
3268        __(box_fixnum(arg_z,imm0))
3269        __(bx lr)
3270local_label(misc_ref_invalid):
3271        __(mov arg_x,#XBADVEC)
3272        __(set_nargs(3))
3273        __(b _SPksignalerr)       
3274_endfn
3275       
3276_exportfn(C(misc_set_common))
3277        __(adr imm0,local_label(misc_set_jmp))
3278        __(ldr pc,[imm0,imm1,lsl #2])
3279local_label(misc_set_jmp):             
3280        /* 00-0*/
3281        .long local_label(misc_set_invalid) /* 00 even_fixnum  */
3282        .long local_label(misc_set_invalid) /* 01 cons  */
3283        .long local_label(misc_set_invalid) /* 02 nodeheader  */
3284        .long local_label(misc_set_invalid) /* 03 imm  */
3285        .long local_label(misc_set_invalid) /* 04 odd_fixnum  */
3286        .long local_label(misc_set_invalid) /* 05 nil  */
3287        .long local_label(misc_set_invalid) /* 06 misc  */
3288        .long local_label(misc_set_u32) /* 07 bignum  */
3289        .long local_label(misc_set_invalid) /* 08 even_fixnum  */
3290        .long local_label(misc_set_invalid) /* 09 cons  */
3291        .long _SPgvset /* 0a ratio  */
3292        .long local_label(misc_set_invalid) /* 0b imm  */
3293        .long local_label(misc_set_invalid) /* 0c odd_fixnum  */
3294        .long local_label(misc_set_invalid) /* 0d nil  */
3295        .long local_label(misc_set_invalid) /* 0e misc  */
3296        .long local_label(misc_set_u32) /* 0f single_float  */
3297        /* 10-1*/
3298        .long local_label(misc_set_invalid) /* 10 even_fixnum  */
3299        .long local_label(misc_set_invalid) /* 11 cons  */
3300        .long local_label(misc_set_invalid) /* 12 nodeheader  */
3301        .long local_label(misc_set_invalid) /* 13 imm  */
3302        .long local_label(misc_set_invalid) /* 14 odd_fixnum  */
3303        .long local_label(misc_set_invalid) /* 15 nil  */
3304        .long local_label(misc_set_invalid) /* 16 misc  */
3305        .long local_label(misc_set_u32) /* 17 double_float  */
3306        .long local_label(misc_set_invalid) /* 18 even_fixnum  */
3307        .long local_label(misc_set_invalid) /* 19 cons  */
3308        .long _SPgvset /* 1a complex  */
3309        .long local_label(misc_set_invalid) /* 1b imm  */
3310        .long local_label(misc_set_invalid) /* 1c odd_fixnum  */
3311        .long local_label(misc_set_invalid) /* 1d nil  */
3312        .long local_label(misc_set_invalid) /* 1e misc  */
3313        .long local_label(misc_set_u32) /* 1f macptr  */
3314        /* 20-2*/
3315        .long local_label(misc_set_invalid) /* 20 even_fixnum  */
3316        .long local_label(misc_set_invalid) /* 21 cons  */
3317        .long _SPgvset /* 22 catch_frame  */
3318        .long local_label(misc_set_invalid) /* 23 imm  */
3319        .long local_label(misc_set_invalid) /* 24 odd_fixnum  */
3320        .long local_label(misc_set_invalid) /* 25 nil  */
3321        .long local_label(misc_set_invalid) /* 26 misc  */
3322        .long local_label(misc_set_u32) /* 27 dead_macptr  */
3323        .long local_label(misc_set_invalid) /* 28 even_fixnum  */
3324        .long local_label(misc_set_invalid) /* 29 cons  */
3325        .long _SPgvset /* 2a function  */
3326        .long local_label(misc_set_invalid) /* 2b imm  */
3327        .long local_label(misc_set_invalid) /* 2c odd_fixnum  */
3328        .long local_label(misc_set_invalid) /* 2d nil  */
3329        .long local_label(misc_set_invalid) /* 2e misc  */
3330        .long local_label(misc_set_u32) /* 2f code_vector  */
3331        /* 30-3*/
3332        .long local_label(misc_set_invalid) /* 30 even_fixnum  */
3333        .long local_label(misc_set_invalid) /* 31 cons  */
3334        .long _SPgvset /* 32 lisp_thread  */
3335        .long local_label(misc_set_invalid) /* 33 imm  */
3336        .long local_label(misc_set_invalid) /* 34 odd_fixnum  */
3337        .long local_label(misc_set_invalid) /* 35 nil  */
3338        .long local_label(misc_set_invalid) /* 36 misc  */
3339        .long local_label(misc_set_u32) /* 37 creole  */
3340        .long local_label(misc_set_invalid) /* 38 even_fixnum  */
3341        .long local_label(misc_set_invalid) /* 39 cons  */
3342        .long _SPgvset /* 3a symbol  */
3343        .long local_label(misc_set_invalid) /* 3b imm  */
3344        .long local_label(misc_set_invalid) /* 3c odd_fixnum  */
3345        .long local_label(misc_set_invalid) /* 3d nil  */
3346        .long local_label(misc_set_invalid) /* 3e misc  */
3347        .long local_label(misc_set_u32) /* 3f xcode_vector  */
3348        /* 40-4*/
3349        .long local_label(misc_set_invalid) /* 40 even_fixnum  */
3350        .long local_label(misc_set_invalid) /* 41 cons  */
3351        .long _SPgvset /* 42 lock  */
3352        .long local_label(misc_set_invalid) /* 43 imm  */
3353        .long local_label(misc_set_invalid) /* 44 odd_fixnum  */
3354        .long local_label(misc_set_invalid) /* 45 nil  */
3355        .long local_label(misc_set_invalid) /* 46 misc  */
3356        .long local_label(misc_set_invalid) /* 47 immheader  */
3357        .long local_label(misc_set_invalid) /* 48 even_fixnum  */
3358        .long local_label(misc_set_invalid) /* 49 cons  */
3359        .long _SPgvset /* 4a hash_vector  */
3360        .long local_label(misc_set_invalid) /* 4b imm  */
3361        .long local_label(misc_set_invalid) /* 4c odd_fixnum  */
3362        .long local_label(misc_set_invalid) /* 4d nil  */
3363        .long local_label(misc_set_invalid) /* 4e misc  */
3364        .long local_label(misc_set_invalid) /* 4f immheader  */
3365        /* 50-5*/
3366        .long local_label(misc_set_invalid) /* 50 even_fixnum  */
3367        .long local_label(misc_set_invalid) /* 51 cons  */
3368        .long _SPgvset /* 52 pool  */
3369        .long local_label(misc_set_invalid) /* 53 imm  */
3370        .long local_label(misc_set_invalid) /* 54 odd_fixnum  */
3371        .long local_label(misc_set_invalid) /* 55 nil  */
3372        .long local_label(misc_set_invalid) /* 56 misc  */
3373        .long local_label(misc_set_invalid) /* 57 immheader  */
3374        .long local_label(misc_set_invalid) /* 58 even_fixnum  */
3375        .long local_label(misc_set_invalid) /* 59 cons  */
3376        .long _SPgvset /* 5a weak  */
3377        .long local_label(misc_set_invalid) /* 5b imm  */
3378        .long local_label(misc_set_invalid) /* 5c odd_fixnum  */
3379        .long local_label(misc_set_invalid) /* 5d nil  */
3380        .long local_label(misc_set_invalid) /* 5e misc  */
3381        .long local_label(misc_set_invalid) /* 5f immheader  */
3382        /* 60-6*/
3383        .long local_label(misc_set_invalid) /* 60 even_fixnum  */
3384        .long local_label(misc_set_invalid) /* 61 cons  */
3385        .long _SPgvset /* 62 package  */
3386        .long local_label(misc_set_invalid) /* 63 imm  */
3387        .long local_label(misc_set_invalid) /* 64 odd_fixnum  */
3388        .long local_label(misc_set_invalid) /* 65 nil  */
3389        .long local_label(misc_set_invalid) /* 66 misc  */
3390        .long local_label(misc_set_invalid) /* 67 immheader  */
3391        .long local_label(misc_set_invalid) /* 68 even_fixnum  */
3392        .long local_label(misc_set_invalid) /* 69 cons  */
3393        .long _SPgvset /* 6a slot_vector  */
3394        .long local_label(misc_set_invalid) /* 6b imm  */
3395        .long local_label(misc_set_invalid) /* 6c odd_fixnum  */
3396        .long local_label(misc_set_invalid) /* 6d nil  */
3397        .long local_label(misc_set_invalid) /* 6e misc  */
3398        .long local_label(misc_set_invalid) /* 6f immheader  */
3399        /* 70-7*/
3400        .long local_label(misc_set_invalid) /* 70 even_fixnum  */
3401        .long local_label(misc_set_invalid) /* 71 cons  */
3402        .long _SPgvset /* 72 instance  */
3403        .long local_label(misc_set_invalid) /* 73 imm  */
3404        .long local_label(misc_set_invalid) /* 74 odd_fixnum  */
3405        .long local_label(misc_set_invalid) /* 75 nil  */
3406        .long local_label(misc_set_invalid) /* 76 misc  */
3407        .long local_label(misc_set_invalid) /* 77 immheader  */
3408        .long local_label(misc_set_invalid) /* 78 even_fixnum  */
3409        .long local_label(misc_set_invalid) /* 79 cons  */
3410        .long _SPgvset /* 7a struct  */
3411        .long local_label(misc_set_invalid) /* 7b imm  */
3412        .long local_label(misc_set_invalid) /* 7c odd_fixnum  */
3413        .long local_label(misc_set_invalid) /* 7d nil  */
3414        .long local_label(misc_set_invalid) /* 7e misc  */
3415        .long local_label(misc_set_invalid) /* 7f immheader  */
3416        /* 80-8*/
3417        .long local_label(misc_set_invalid) /* 80 even_fixnum  */
3418        .long local_label(misc_set_invalid) /* 81 cons  */
3419        .long _SPgvset /* 82 istruct  */
3420        .long local_label(misc_set_invalid) /* 83 imm  */
3421        .long local_label(misc_set_invalid) /* 84 odd_fixnum  */
3422        .long local_label(misc_set_invalid) /* 85 nil  */
3423        .long local_label(misc_set_invalid) /* 86 misc  */
3424        .long local_label(misc_set_invalid) /* 87 immheader  */
3425        .long local_label(misc_set_invalid) /* 88 even_fixnum  */
3426        .long local_label(misc_set_invalid) /* 89 cons  */
3427        .long _SPgvset /* 8a value_cell  */
3428        .long local_label(misc_set_invalid) /* 8b imm  */
3429        .long local_label(misc_set_invalid) /* 8c odd_fixnum  */
3430        .long local_label(misc_set_invalid) /* 8d nil  */
3431        .long local_label(misc_set_invalid) /* 8e misc  */
3432        .long local_label(misc_set_invalid) /* 8f immheader  */
3433        /* 90-9*/
3434        .long local_label(misc_set_invalid) /* 90 even_fixnum  */
3435        .long local_label(misc_set_invalid) /* 91 cons  */
3436        .long _SPgvset /* 92 xfunction  */
3437        .long local_label(misc_set_invalid) /* 93 imm  */
3438        .long local_label(misc_set_invalid) /* 94 odd_fixnum  */
3439        .long local_label(misc_set_invalid) /* 95 nil  */
3440        .long local_label(misc_set_invalid) /* 96 misc  */
3441        .long local_label(misc_set_invalid) /* 97 immheader  */
3442        .long local_label(misc_set_invalid) /* 98 even_fixnum  */
3443        .long local_label(misc_set_invalid) /* 99 cons  */
3444        .long _SPgvset /* 9a arrayH  */
3445        .long local_label(misc_set_invalid) /* 9b imm  */
3446        .long local_label(misc_set_invalid) /* 9c odd_fixnum  */
3447        .long local_label(misc_set_invalid) /* 9d nil  */
3448        .long local_label(misc_set_invalid) /* 9e misc  */
3449        .long local_label(misc_set_invalid) /* 9f immheader  */
3450        /* a0-af  */
3451        .long local_label(misc_set_invalid) /* a0 even_fixnum  */
3452        .long local_label(misc_set_invalid) /* a1 cons  */
3453        .long _SPgvset /* a2 vectorH  */
3454        .long local_label(misc_set_invalid) /* a3 imm  */
3455        .long local_label(misc_set_invalid) /* a4 odd_fixnum  */
3456        .long local_label(misc_set_invalid) /* a5 nil  */
3457        .long local_label(misc_set_invalid) /* a6 misc  */
3458        .long local_label(misc_set_single_float_vector) /* a7 sf vector  */
3459        .long local_label(misc_set_invalid) /* a8 even_fixnum  */
3460        .long local_label(misc_set_invalid) /* a9 cons  */
3461        .long _SPgvset /* aa vectorH  */
3462        .long local_label(misc_set_invalid) /* ab imm  */
3463        .long local_label(misc_set_invalid) /* ac odd_fixnum  */
3464        .long local_label(misc_set_invalid) /* ad nil  */
3465        .long local_label(misc_set_invalid) /* ae misc  */
3466        .long local_label(misc_set_u32) /* af u32  */
3467        /* b0-bf  */
3468        .long local_label(misc_set_invalid) /* b0 even_fixnum  */
3469        .long local_label(misc_set_invalid) /* b1 cons  */
3470        .long local_label(misc_set_invalid) /* b2 node  */
3471        .long local_label(misc_set_invalid) /* b3 imm  */
3472        .long local_label(misc_set_invalid) /* b4 odd_fixnum  */
3473        .long local_label(misc_set_invalid) /* b5 nil  */
3474        .long local_label(misc_set_invalid) /* b6 misc  */
3475        .long local_label(misc_set_s32) /* b7 s32  */
3476        .long local_label(misc_set_invalid) /* b8 even_fixnum  */
3477        .long local_label(misc_set_invalid) /* b9 cons  */
3478        .long local_label(misc_set_invalid) /* ba nodeheader  */
3479        .long local_label(misc_set_invalid) /* bb imm  */
3480        .long local_label(misc_set_invalid) /* bc odd_fixnum  */
3481        .long local_label(misc_set_invalid) /* bd nil  */
3482        .long local_label(misc_set_invalid) /* be misc  */
3483        .long local_label(misc_set_fixnum_vector) /* bf fixnum_vector  */
3484        /* c0-cf  */
3485        .long local_label(misc_set_invalid) /* c0 even_fixnum  */
3486        .long local_label(misc_set_invalid) /* c1 cons  */
3487        .long local_label(misc_set_invalid) /* c2 nodeheader  */
3488        .long local_label(misc_set_invalid) /* c3 imm  */
3489        .long local_label(misc_set_invalid) /* c4 odd_fixnum  */
3490        .long local_label(misc_set_invalid) /* c5 nil  */
3491        .long local_label(misc_set_invalid) /* c6 misc  */
3492        .long local_label(misc_set_new_string) /* c7 new_string  */
3493        .long local_label(misc_set_invalid) /* c8 even_fixnum  */
3494        .long local_label(misc_set_invalid) /* c9 cons  */
3495        .long local_label(misc_set_invalid) /* ca nodeheader  */
3496        .long local_label(misc_set_invalid) /* cb imm  */
3497        .long local_label(misc_set_invalid) /* cc odd_fixnum  */
3498        .long local_label(misc_set_invalid) /* cd nil  */
3499        .long local_label(misc_set_invalid) /* ce misc  */
3500        .long local_label(misc_set_u8) /* cf u8  */
3501        /* d0-df  */
3502        .long local_label(misc_set_invalid) /* d0 even_fixnum  */
3503        .long local_label(misc_set_invalid) /* d1 cons  */
3504        .long local_label(misc_set_invalid) /* d2 nodeheader  */
3505        .long local_label(misc_set_invalid) /* d3 imm  */
3506        .long local_label(misc_set_invalid) /* d4 odd_fixnum  */
3507        .long local_label(misc_set_invalid) /* d5 nil  */
3508        .long local_label(misc_set_invalid) /* d6 misc  */
3509        .long local_label(misc_set_s8) /* d7 s8  */
3510        .long local_label(misc_set_invalid) /* d8 even_fixnum  */
3511        .long local_label(misc_set_invalid) /* d9 cons  */
3512        .long local_label(misc_set_invalid) /* da nodeheader  */
3513        .long local_label(misc_set_invalid) /* db imm  */
3514        .long local_label(misc_set_invalid) /* dc odd_fixnum  */
3515        .long local_label(misc_set_invalid) /* dd nil  */
3516        .long local_label(misc_set_invalid) /* de misc  */
3517        .long local_label(misc_set_old_string) /* df (old) simple_base_string  */
3518        /* e0-ef  */
3519        .long local_label(misc_set_invalid) /* e0 even_fixnum  */
3520        .long local_label(misc_set_invalid) /* e1 cons  */
3521        .long local_label(misc_set_invalid) /* e2 nodeheader  */
3522        .long local_label(misc_set_invalid) /* e3 imm  */
3523        .long local_label(misc_set_invalid) /* e4 odd_fixnum  */
3524        .long local_label(misc_set_invalid) /* e5 nil  */
3525        .long local_label(misc_set_invalid) /* e6 misc  */
3526        .long local_label(misc_set_u16) /* e7 u16  */
3527        .long local_label(misc_set_invalid) /* e8 even_fixnum  */
3528        .long local_label(misc_set_invalid) /* e9 cons  */
3529        .long local_label(misc_set_invalid) /* ea nodeheader  */
3530        .long local_label(misc_set_invalid) /* eb imm  */
3531        .long local_label(misc_set_invalid) /* ec odd_fixnum  */
3532        .long local_label(misc_set_invalid) /* ed nil  */
3533        .long local_label(misc_set_invalid) /* ee misc  */
3534        .long local_label(misc_set_s16) /* ef s16  */
3535        /* f0-ff  */
3536        .long local_label(misc_set_invalid) /* f0 even_fixnum  */
3537        .long local_label(misc_set_invalid) /* f1 cons  */
3538        .long local_label(misc_set_invalid) /* f2 nodeheader  */
3539        .long local_label(misc_set_invalid) /* f3 imm  */
3540        .long local_label(misc_set_invalid) /* f4 odd_fixnum  */
3541        .long local_label(misc_set_invalid) /* f5 nil  */
3542        .long local_label(misc_set_invalid) /* f6 misc  */
3543        .long local_label(misc_set_double_float_vector) /* f7 df vector  */
3544        .long local_label(misc_set_invalid) /* f8 even_fixnum  */
3545        .long local_label(misc_set_invalid) /* f9 cons  */
3546        .long local_label(misc_set_invalid) /* fa nodeheader  */
3547        .long local_label(misc_set_invalid) /* fb imm  */
3548        .long local_label(misc_set_invalid) /* fc odd_fixnum  */
3549        .long local_label(misc_set_invalid) /* fd nil  */
3550        .long local_label(misc_set_invalid) /* fe misc  */
3551        .long local_label(misc_set_bit_vector) /* ff bit_vector  */
3552
3553local_label(misc_set_u32):       
3554        /* Either a non-negative fixnum, a positive one-digit bignum, */
3555        /* or a two-digit bignum whose sign-digit is 0 is ok.  */
3556        __(add imm0,arg_y,#misc_data_offset)
3557        __(test_fixnum(arg_z))
3558        __(bne local_label(set_not_fixnum_u32))
3559        __(tst arg_z,#0x80000000)
3560        __(bne local_label(set_bad))
3561        __(unbox_fixnum(imm1,arg_z))
3562local_label(set_set32):         
3563        __(str imm1,[arg_x,imm0])
3564        __(bx lr)
3565local_label(set_not_fixnum_u32):
3566        __(extract_lisptag(imm1,arg_z))
3567        __(cmp imm1,#tag_misc)
3568        __(bne local_label(set_bad))
3569        __(movc16(imm2,one_digit_bignum_header))
3570        __(getvheader(imm1,arg_z))
3571        __(cmp imm1,imm2)
3572        __(bne local_label(set_not_1_digit_u32))
3573        __(ldr imm1,[arg_z,#misc_data_offset])
3574        __(cmp imm1,#0)
3575        __(bge local_label(set_set32))
3576        __(b local_label(set_bad))
3577local_label(set_not_1_digit_u32):
3578        __(movc16(imm2,two_digit_bignum_header))
3579        __(cmp imm1,imm2)
3580        __(bne local_label(set_bad))
3581        __(vrefr(imm2,arg_z,1))
3582        __(vrefr(imm1,arg_z,0))
3583        __(cmp imm2,#0)
3584        __(beq local_label(set_set32))
3585local_label(set_bad):
3586        /* arg_z does not match the array-element-type of arg_x.  */
3587        __(mov arg_y,arg_z)
3588        __(mov arg_z,arg_x)
3589        __(mov arg_x,#XNOTELT)
3590        __(set_nargs(3))
3591        __(b _SPksignalerr)
3592local_label(misc_set_fixnum_vector):   
3593        __(add imm0,arg_z,#misc_data_offset)
3594        __(test_fixnum(arg_z))
3595        __(bne local_label(set_bad))
3596        __(unbox_fixnum(imm1,arg_z))
3597        __(str imm1,[arg_x,imm0])
3598        __(bx lr)
3599local_label(misc_set_new_string):   
3600        __(add imm0,arg_z,#misc_data_offset)
3601        __(extract_lowbyte(imm2,arg_z))
3602        __(cmp imm2,#subtag_character)
3603        __(bne local_label(set_bad))
3604        __(unbox_character(imm1,arg_z))
3605        __(str imm1,[arg_x,imm0])
3606        __(bx lr)
3607local_label(misc_set_s32):
3608        __(add imm0,arg_z,#misc_data_offset)
3609        __(test_fixnum(arg_z))
3610        __(moveq imm1,arg_z,asr #fixnumshift)
3611        __(beq local_label(set_set32))
3612        __(extract_lisptag(imm2,arg_z))
3613        __(cmp imm2,#tag_misc)
3614        __(bne local_label(set_bad))
3615        __(movc16(imm1,one_digit_bignum_header))
3616        __(getvheader(imm2,arg_z))
3617        __(cmp imm2,imm1)
3618        __(vrefr(imm1,arg_z,0))
3619        __(beq local_label(set_set32))
3620        __(b local_label(set_bad))
3621local_label(misc_set_single_float_vector):
3622        __(add imm0,arg_z,#misc_data_offset)
3623        __(extract_typecode(imm2,arg_z))
3624        __(cmp imm2,#subtag_single_float)
3625        __(bne local_label(set_bad))
3626        __(ldr imm1,[arg_z,#single_float.value])
3627        __(str imm1,[arg_x,imm0])
3628        __(bx lr)
3629local_label(misc_set_u8):               
3630        __(mov imm0,arg_y,lsr #2)
3631        __(add imm0,imm0,#misc_data_offset)
3632        __(mov imm2,#~(0xff<<fixnumshift))
3633        __(tst arg_z,imm2)
3634        __(bne local_label(set_bad))
3635        __(unbox_fixnum(imm1,arg_z))
3636        __(strb imm1,[arg_x,imm0])
3637        __(bx lr)
3638local_label(misc_set_old_string):
3639        __(mov imm0,arg_y,lsr #2)
3640        __(add imm0,imm0,#misc_data_offset)
3641        __(extract_lowbyte(imm2,arg_z))
3642        __(cmp imm2,#subtag_character)
3643        __(unbox_character(imm1,arg_z))
3644        __(bne local_label(set_bad))
3645        __(strb imm1,[arg_x,imm0])
3646        __(bx lr)
3647local_label(misc_set_s8):
3648        __(mov imm0,arg_y,lsr #2)
3649        __(add imm0,imm0,#misc_data_offset)
3650        __(test_fixnum(arg_z))
3651        __(bne local_label(set_bad))
3652        __(unbox_fixnum(imm1,arg_z))
3653        __(mov imm2,imm1,lsl #32-8)
3654        __(cmp imm1,imm2,asr #32-8)
3655        __(bne local_label(set_bad))
3656        __(strb imm1,[arg_x,imm0])
3657        __(bx lr)
3658local_label(misc_set_u16):         
3659        __(mov imm0,arg_y,lsr #1)
3660        __(add imm0,imm0,#misc_data_offset)
3661        __(test_fixnum(arg_z))
3662        __(bne local_label(set_bad))
3663        __(unbox_fixnum(imm1,arg_z))
3664        __(mov imm2,imm1,lsl #16)
3665        __(cmp imm1,imm2,lsr #16)
3666        __(bne local_label(set_bad))
3667        __(strh imm1,[arg_x,imm0])
3668        __(bx lr)
3669local_label(misc_set_s16):
3670        __(mov imm0,arg_y,lsr #1)
3671        __(add imm0,imm0,#misc_data_offset)
3672        __(test_fixnum(arg_z))
3673        __(bne local_label(set_bad))
3674        __(unbox_fixnum(imm1,arg_z))
3675        __(mov imm2,imm1,lsl #16)
3676        __(cmp imm1,imm2,asr #16)
3677        __(bne local_label(set_bad))
3678        __(strh imm1,[arg_x,imm0])
3679        __(bx lr)
3680local_label(misc_set_bit_vector):
3681        __(bics imm0,arg_z,#fixnumone)
3682        __(bne local_label(set_bad))
3683        __(mov imm2,#31)
3684        __(and imm2,imm1,arg_y,lsr #2)
3685        __(mov imm1,#1)
3686        __(mov imm1,imm1,lsl imm2)
3687        __(mov imm0,arg_y,lsr #fixnumshift+5)
3688        __(mov imm0,imm0,lsl #2)
3689        __(add imm0,imm0,#misc_data_offset)
3690        __(cmp arg_z,#0)
3691        __(ldr imm2,[arg_x,imm0])
3692        __(orrne imm2,imm2,imm1)
3693        __(biceq imm2,imm2,imm1)
3694        __(str imm2,[arg_x,imm0])
3695        __(bx lr)
3696
3697local_label(misc_set_double_float_vector):
3698        __(extract_subtag(imm2,arg_z))
3699        __(cmp imm2,#subtag_double_float)
3700        __(bne local_label(misc_set_bad))
3701        __(ldrd imm0,imm1,[arg_z,#misc_dfloat_offset])
3702        __(mov imm2,arg_y,lsl #1)
3703        __(add imm2,imm2,#misc_dfloat_offset)
3704        __(strd imm0,imm1,[arg_x,imm2])
3705        __(bx lr)
3706local_label(misc_set_invalid): 
3707        __(mov temp0,#XSETBADVEC)       
3708        __(set_nargs(4))
3709        __(vpush1(temp0))
3710        __(b _SPksignalerr)               
3711
3712C(destbind1): 
3713dnl  /* Extract required arg count.  */
3714dnl  /* A bug in gas: can't handle shift count of "32" (= 0  */
3715dnl  ifelse(eval(mask_req_width+mask_req_start),eval(32),`
3716dnl  __(clrlwi. imm0,nargs,mask_req_start)
3717dnl  ',`
3718dnl  __(extrwi. imm0,nargs,mask_req_width,mask_req_start)
3719dnl  ')
3720dnl  __(extrwi imm1,nargs,mask_opt_width,mask_opt_start)
3721dnl  __(rlwinm imm2,nargs,0,mask_initopt,mask_initopt)
3722dnl  __(rlwinm imm4,nargs,0,mask_keyp,mask_keyp)
3723dnl  __(cmpri(cr4,imm4,0))
3724dnl  __(rlwinm imm4,nargs,0,mask_restp,mask_restp)
3725dnl  __(cmpri(cr5,imm4,0))
3726dnl  __(cmpri(cr1,imm1,0))
3727dnl  __(cmpri(cr2,imm2,0))
3728dnl  /* Save entry vsp in case of error.  */
3729dnl  __(mov imm4,vsp)
3730dnl  __(beq 2f)
3731dnl 1:
3732dnl  __(cmpri(cr7,arg_reg,nil_value))
3733dnl   __(extract_lisptag(imm3,arg_reg))
3734dnl   __(cmpri(cr3,imm3,tag_list))
3735dnl  __(subi imm0,imm0,1)
3736dnl  __(cmpri(imm0,0))
3737dnl  __(beq cr7,toofew)
3738dnl  __(bne cr3,badlist)
3739dnl  __(ldr arg_x,[arg_reg,#cons.car])
3740dnl  __(ldr arg_reg,[arg_reg,#cons.cdr])
3741dnl  __(vpush1(arg_x))
3742dnl  __(bne 1b)
3743dnl 2:
3744dnl  __(beq cr1,rest_keys)
3745dnl  __(bne cr2,opt_supp)
3746dnl  /* 'simple' &optionals:  no supplied-p, default to nil.  */
3747dnl simple_opt_loop:
3748dnl  __(cmpri(arg_reg,nil_value))
3749dnl   __(extract_lisptag(imm3,arg_reg))
3750dnl   __(cmpri(cr3,imm3,tag_list))
3751dnl  __(subi imm1,imm1,1)
3752dnl  __(cmpri(cr1,imm1,0))
3753dnl  __(mov imm5,#nil_value)
3754dnl  __(beq default_simple_opt)
3755dnl  __(bne cr3,badlist)
3756dnl  __(ldr arg_x,[arg_reg,#cons.car])
3757dnl  __(ldr arg_reg,[arg_reg,#cons.cdr])
3758dnl  __(vpush1(arg_x))
3759dnl  __(bne cr1,simple_opt_loop)
3760dnl  __(b rest_keys)
3761dnl default_simple_opt_loop:
3762dnl  __(subi imm1,imm1,1)
3763dnl  __(cmpri(cr1,imm1,0))
3764dnl default_simple_opt:
3765dnl  __(vpush1(imm5))
3766dnl  __(bne cr1,default_simple_opt_loop)
3767dnl  __(b rest_keys)
3768dnl  /* Provide supplied-p vars for the &optionals.  */
3769dnl opt_supp:
3770dnl  __(mov arg_y,#t_value)
3771dnl opt_supp_loop:
3772dnl  __(cmpri(arg_reg,nil_value))
3773dnl   __(extract_lisptag(imm3,arg_reg))
3774dnl   __(cmpri(cr3,imm3,tag_list))
3775dnl  __(subi imm1,imm1,1)
3776dnl  __(cmpri(cr1,imm1,0))
3777dnl  __(beq default_hard_opt)
3778dnl  __(bne cr3,badlist)
3779dnl  __(ldr arg_x,[arg_reg,#cons.car])
3780dnl  __(ldr arg_reg,[arg_reg,#cons.cdr])
3781dnl  __(vpush1(arg_x))
3782dnl  __(vpush1(arg_y))
3783dnl  __(bne cr1,opt_supp_loop)
3784dnl  __(b rest_keys)
3785dnl default_hard_opt_loop:
3786dnl  __(subi imm1,imm1,1)
3787dnl  __(cmpri(cr1,imm1,0))
3788dnl default_hard_opt:
3789dnl  __(vpush1(imm5))
3790dnl  __(vpush1(imm5))
3791dnl  __(bne cr1,default_hard_opt_loop)
3792dnl rest_keys:
3793dnl  __(cmpri(arg_reg,nil_value))
3794dnl  __(bne cr5,have_rest)
3795dnl  __(bne cr4,have_keys)
3796dnl  __(bne toomany)
3797dnl  __(bx lr)
3798dnl have_rest:
3799dnl  __(vpush1(arg_reg))
3800dnl  __(beqlr cr4)
3801dnl have_keys:
3802dnl  /* Ensure that arg_reg contains a proper,even-length list.  */
3803dnl  /* Insist that its length is <= 512 (as a cheap circularity check.)  */
3804dnl  __(mov imm0,#256)
3805dnl  __(mov arg_x,arg_reg)
3806dnl count_keys_loop:
3807dnl   __(extract_lisptag(imm3,arg_x))
3808dnl   __(cmpri(cr3,imm3,tag_list))
3809dnl  __(cmpri(arg_x,nil_value))
3810dnl  __(subi imm0,imm0,1)
3811dnl  __(cmpri(cr4,imm0,0))
3812dnl  __(beq counted_keys)
3813dnl  __(bne cr3,badlist)
3814dnl  __(ldr arg_x,[arg_x,#cons.cdr])
3815dnl   __(extract_lisptag(imm3,arg_x))
3816dnl   __(cmpri(cr3,imm3,tag_list))
3817dnl  __(blt cr4,toomany)
3818dnl  __(cmpri(arg_x,nil_value))
3819dnl  __(beq db_badkeys)
3820dnl  __(bne cr3,badlist)
3821dnl  __(ldr arg_x,[arg_x,#cons.cdr])
3822dnl  __(b count_keys_loop)
3823dnl counted_keys:
3824dnl  /* We've got a proper, even-length list of key/value pairs in */
3825dnl  /* arg_reg. For each keyword var in the lambda-list, push a pair */
3826dnl  /* of NILs on the vstack.  */
3827dnl  __(extrwi. imm0,nargs,mask_key_width,mask_key_start )
3828dnl  __(mov imm2,imm0)  /* save number of keys  */
3829dnl  __(mov imm5,#nil_value)
3830dnl  __(b push_pair_test)
3831dnl push_pair_loop:
3832dnl  __(cmpri(imm0,1))
3833dnl  __(subi imm0,imm0,1)
3834dnl  __(vpush1(imm5))
3835dnl  __(vpush1(imm5))
3836dnl push_pair_test:
3837dnl  __(bne push_pair_loop)
3838dnl  __(slwi imm2,imm2,dnode_shift)  /* pairs -> bytes  */
3839dnl  __(add imm2,vsp,imm2)  /* imm2 points below pairs  */
3840dnl  __(mov imm0,#0)   /* count unknown keywords so far  */
3841dnl  __(extrwi imm1,nargs,1,mask_aok) /* unknown keywords allowed  */
3842dnl  __(extrwi nargs,nargs,mask_key_width,mask_key_start)
3843dnl  /* Now, for each keyword/value pair in the list  */
3844dnl  /*  a) if the keyword is found in the keyword vector, set the  */
3845dnl  /*     corresponding entry on the vstack to the value and the  */
3846dnl  /*     associated supplied-p var to T.  */
3847dnl  /*  b) Regardless of whether or not the keyword is found,  */
3848dnl         /*     if :ALLOW-OTHER-KEYS is provided with a non-nil value, */
3849dnl  /*     set the low bit of imm1 to indicate that unknown keywords  */
3850dnl  /*     are acceptable. (This bit is pre-set above to the value */
3851dnl         /*     the encoded value of &allow_other_keys.) */
3852dnl  /*  c) If the keyword is not found (and isn't :ALLOW-OTHER-KEYS), increment  */
3853dnl  /*     the count of unknown keywords in the high bits of imm1*/
3854dnl  /* At the end of the list, signal an error if any unknown keywords were seen  */
3855dnl  /* but not allowed.  Otherwise, return.  */
3856dnl
3857dnl match_keys_loop:
3858dnl  __(cmpri(arg_reg,nil_value))
3859dnl  __(mov imm0,#0)
3860dnl  __(mov imm3,#misc_data_offset)
3861dnl  __(beq matched_keys)
3862dnl  __(ldr arg_x,[arg_reg,#cons.car])
3863dnl  __(mov arg_y,#nrs.kallowotherkeys)
3864dnl  __(cmpr(cr3,arg_x,arg_y)) /* :ALLOW-OTHER-KEYS ?  */
3865dnl  __(ldr arg_reg,[arg_reg,#cons.cdr])
3866dnl  __(ldr arg_y,[arg_reg,#cons.car])
3867dnl  __(cmpr(cr4,imm0,nargs))
3868dnl  __(ldr arg_reg,[arg_reg,#cons.cdr])
3869dnl  __(b match_test)
3870dnl match_loop:
3871dnl  __(ldrx(temp0,keyvect_reg,imm3))
3872dnl  __(cmpr(arg_x,temp0))
3873dnl  __(addi imm0,imm0,1)
3874dnl  __(cmpr(cr4,imm0,nargs))
3875dnl  __(addi imm3,imm3,node_size)
3876dnl  __(bne match_test)
3877dnl  /* Got a hit.  Unless this keyword's been seen already, set it.  */
3878dnl  __(slwi imm0,imm0,dnode_shift)
3879dnl  __(subf imm0,imm0,imm2)
3880dnl  __(ldr temp0,[imm0,#0])
3881dnl  __(cmpri(temp0,nil_value))
3882dnl  __(mov temp0,#t_value)
3883dnl  __(bne match_keys_loop) /* already saw this  */
3884dnl  __(str(arg_y,node_size*1(imm0)))
3885dnl  __(str(temp0,node_size*0(imm0)))
3886dnl         __(bne cr3,match_keys_loop)
3887dnl  __(b match_keys_check_aok)
3888dnl match_test:
3889dnl  __(bne cr4,match_loop)
3890dnl         __(beq cr3,match_keys_check_aok)
3891dnl         __(addi imm1,imm1,node_size)
3892dnl         __(b match_keys_loop)
3893dnl match_keys_check_aok:
3894dnl         __(andi. imm0,imm1,2)  /* check "seen-aok" bit in imm1 */
3895dnl         __(cmpri cr1,arg_y,nil_value) /* check value */
3896dnl         __(ori imm1,imm1,2)
3897dnl         __(bne match_keys_loop) /* duplicate aok */
3898dnl         __(beq cr1,match_keys_loop)
3899dnl         __(ori imm1,imm1,1)
3900dnl  __(b match_keys_loop)
3901dnl matched_keys:
3902dnl         __(clrrwi. imm0,imm1,2)
3903dnl         __(beqlr)
3904dnl         __(andi. imm1,imm1,1)
3905dnl         __(bnelr)
3906dnl  /* Some unrecognized keywords.  Complain generically about  */
3907dnl  /* invalid keywords.  */
3908dnl db_badkeys:
3909dnl  __(mov arg_y,#XBADKEYS)
3910dnl  __(b destructure_error)
3911dnl toomany:
3912dnl  __(mov arg_y,#XCALLTOOMANY)
3913dnl  __(b destructure_error)
3914dnl toofew:
3915dnl  __(mov arg_y,#XCALLTOOFEW)
3916dnl  __(b destructure_error)
3917dnl badlist:
3918dnl  __(mov arg_y,#XCALLNOMATCH)
3919dnl  /* b destructure_error  */
3920dnl destructure_error:
3921dnl  __(mov vsp,imm4)  /* undo everything done to the stack  */
3922dnl  __(mov arg_z,whole_reg)
3923dnl  __(set_nargs(2))
3924dnl  __(b _SPksignalerr)
3925
3926/* imm2: (tstack-consed) target catch frame, imm0: count of intervening  */
3927/* frames. If target isn't a multiple-value receiver, discard extra values */
3928/* (less hair, maybe.)  */
3929C(_throw_found):
3930pushdef(`__',`
3931        .word 0
3932        ')       
3933        __(ldr imm1,[imm2,#catch_frame.mvflag])
3934        __(cmpri(imm1,0))
3935        __(cmpri(cr1,nargs,0))
3936        __(mov fn,#0)
3937        __(add imm1,vsp,nargs)
3938        __(add imm1,[imm1,#-node_size])
3939        __(bne local_label(_throw_all_values))
3940        __(set_nargs(1))
3941        __(beq cr1,local_label(_throw_default_1_val))
3942        __(mov vsp,imm1)
3943        __(b local_label(_throw_all_values))
3944local_label(_throw_default_1_val):
3945        __(mov imm4,#nil_value)
3946        __(vpush1(imm4))
3947local_label(_throw_all_values):
3948        __(bl _SPnthrowvalues)
3949        __(ldr imm3,[rcontext,#tcr.catch_top])
3950        __(ldr imm1,[rcontext,#tcr.db_link])
3951        __(ldr imm0,[imm3,#catch_frame.db_link])
3952        __(ldr imm4,[imm3,#catch_frame.mvflag])
3953        __(cmpr(imm0,imm1))
3954        __(cmpri(cr1,imm4,0))
3955        __(add tsp,[imm3,#-((tsp_frame.fixed_overhead+fulltag_misc))])
3956        __(beq local_label(_throw_dont_unbind))
3957        __(bl _SPunbind_to)
3958local_label(_throw_dont_unbind):
3959        __(add imm0,vsp,nargs)
3960        __(cmpri(nargs,0))
3961        __(ldr imm1,[imm3,#catch_frame.csp])
3962        __(ldr imm1,[imm1,#lisp_frame.savevsp])
3963        __(bne cr1,local_label(_throw_multiple))
3964        /* Catcher expects single value in arg_z  */
3965        __(ldr arg_z,[imm0,#-node_size])
3966        __(b local_label(_throw_pushed_values))
3967local_label(_throw_multiple):
3968        __(beq local_label(_throw_pushed_values))
3969        __(mov imm2,nargs)
3970local_label(_throw_mvloop):
3971        __(sub imm2,imm2,fixnum_one)
3972        __(cmpri(imm2,0))
3973        __(ldru(temp0,-node_size(imm0)))
3974        __(push(temp0,imm1))
3975        __(bgt local_label(_throw_mvloop))
3976local_label(_throw_pushed_values):
3977        __(mov vsp,imm1)
3978        __(ldr imm1,[imm3,#catch_frame.xframe])
3979        __(str(imm1,tcr.xframe(rcontext)))
3980        __(ldr sp,[imm3,#catch_frame.csp])
3981        __(ldr fn,[sp,#lisp_frame.savefn])
3982        __(ldr loc_pc,[sp,#lisp_frame.savelr])
3983        __(discard_lisp_frame())
3984        __(mtlr loc_pc)
3985        __(restore_catch_nvrs(imm3))
3986        __(ldr imm3,[imm3,#catch_frame.link])
3987        __(str(imm3,tcr.catch_top(rcontext)))
3988        __(unlink(tsp))
3989        __(bx lr)
3990popdef(`__')
3991
3992C(nthrow1v):   
3993local_label(_nthrow1v_nextframe):
3994        __(subs temp2,temp2,#fixnum_one)
3995        __(ldr temp0,[rcontext,#tcr.catch_top])
3996        __(ldr imm1,[rcontext,#tcr.db_link])
3997        __(set_nargs(1))
3998        __(blt local_label(_nthrow1v_done))
3999        __(ldr arg_y,[temp0,#catch_frame.link])
4000        __(ldr imm0,[temp0,#catch_frame.db_link])
4001        __(cmp imm0,imm1)
4002        __(str arg_y,[rcontext,#tcr.catch_top])
4003        __(ldr arg_y,[temp0,#catch_frame.xframe])
4004        __(str arg_y,[rcontext,#tcr.xframe])
4005        __(beq local_label(_nthrow1v_dont_unbind))
4006        __(do_unbind_to(imm0,temp1,arg_x,arg_y))
4007local_label(_nthrow1v_dont_unbind):
4008        __(ldr temp1,[temp0,#catch_frame.catch_tag])
4009        __(cmp temp1,#unbound_marker)  /* unwind-protect ?  */
4010        __(beq local_label(_nthrow1v_do_unwind))
4011        /* A catch frame.  If the last one, restore context from there.  */
4012        __(cmp temp2,#0)
4013        __(ldreq vsp,[sp,#lisp_frame.savevsp])
4014        __(add sp,sp,#catch_frame.size+lisp_frame.size)
4015        __(b local_label(_nthrow1v_nextframe))
4016local_label(_nthrow1v_do_unwind):
4017pushdef(`__',`
4018        .word 0
4019        ')       
4020        /* This is harder, but not as hard (not as much BLTing) as the  */
4021        /* multiple-value case.  */
4022        /* Save our caller's LR and FN in the csp frame created by the unwind-  */
4023        /* protect.  (Clever, eh ?)  */
4024
4025        __(la tsp,-(tsp_frame.fixed_overhead+fulltag_misc)(temp0))
4026        __(unlink(tsp))
4027        __(ldr loc_pc,[sp,#lisp_frame.savelr])
4028        __(ldr nfn,[sp,#lisp_frame.savefn])
4029        __(mtctr loc_pc)  /* cleanup code address.  */
4030        __(str(fn,lisp_frame.savefn(sp)))
4031        __(mflr loc_pc)
4032        __(mov fn,nfn)
4033        __(str(loc_pc,lisp_frame.savelr(sp)))
4034        __(TSP_Alloc_Fixed_Boxed(2*node_size)) /* tsp overhead, value, throw count  */
4035        __(str(arg_z,tsp_frame.data_offset(tsp)))
4036        __(str(temp2,tsp_frame.data_offset+node_size(tsp)))
4037        __(ldr vsp,[sp,#lisp_frame.savevsp])
4038        __(str(rzero,tcr.unwinding(rcontext)))
4039        __(bctrl)
4040        __(mov imm1,#1)
4041        __(ldr arg_z,[tsp,#tsp_frame.data_offset])
4042        __(str(imm1,tcr.unwinding(rcontext)))
4043        __(ldr temp2,[tsp,#tsp_frame.data_offset+node_size])
4044        __(ldr fn,[sp,#lisp_frame.savefn])
4045        __(ldr loc_pc,[sp,#lisp_frame.savelr])
4046        __(discard_lisp_frame())
4047        __(mtlr loc_pc)
4048        __(unlink(tsp))
4049        __(b local_label(_nthrow1v_nextframe))
4050popdef(`__')       
4051local_label(_nthrow1v_done):
4052        __(mov imm0,#0)
4053        __(str imm0,[rcontext,#tcr.unwinding])
4054        /* nargs has an undefined value here, so we can clobber it while */
4055        /* polling for a deferred interrupt  */
4056        __(check_pending_interrupt(nargs))
4057        __(bx lr)
4058       
4059       
4060        _endfile
Note: See TracBrowser for help on using the repository browser.