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

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

More.

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