source: release/1.7/source/lisp-kernel/arm-spentry.s @ 15267

Last change on this file since 15267 was 14845, checked in by gb, 8 years ago

(Should also have been in earlier commit.)

Pass that argument from ARM subrprims that can signal division-by-zero
from software.

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