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

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

.SPdebind: enough of the (very) old destructuring subprim to support
our limited use of it.

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