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

Last change on this file since 13755 was 13755, checked in by gb, 9 years ago

Fix a few typos/brainos.
Define check_fpu_exception, define & implement discard_stack_object.
Drop the variant entry points to keyword_bind; write a (large) version
of keyword_bind that may mostly work.
Add udiv32 and sdiv32, shamelessly stolen from a textbook.

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