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

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

arm2.lisp: 32-bit case of ARM2-VREF1 wasn't parenthesized right, so we did both

the constant- and variable-index case.

arm-vinsns.lisp: lots of bugs in SAVE-LEXPR-ARGREGS
arm-pred.lisp: in EQUAL, compare to NIL, not 'NUL.
l1-clos-boot.lisp: more ARM conditionalization.
arm-spentry.s: use the right register in _SPbind.

Implement _SPnthrowvalues, fix in _SPnthrow1value.
Try to add uuo_debug_trap() to subprims that still aren't implemented.

Currently crashes in code called by ENSURE-METHOD, possibly on the first
DEFMETHOD.

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