source: trunk/ccl/lisp-kernel/spentry.s @ 529

Last change on this file since 529 was 529, checked in by gb, 16 years ago

Fix a lot of the cases broken by removal of extract_2_lisptags_.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 126.3 KB
Line 
1/*
2   Copyright (C) 1994-2001 Digitool, Inc
3   This file is part of OpenMCL. 
4
5   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
6   License , known as the LLGPL and distributed with OpenMCL as the
7   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
8   which is distributed with OpenMCL as the file "LGPL".  Where these
9   conflict, the preamble takes precedence. 
10
11   OpenMCL is referenced in the preamble as the "LIBRARY."
12
13   The LLGPL is also available online at
14   http://opensource.franz.com/preamble.html
15
16*/
17
18       
19        include(lisp.s)
20        _beginfile
21       
22local_label(start):     
23define([_spentry],[ifdef([__func_name],[_endfn],[])
24        .align 5
25        _exportfn(_SP$1)
26        .line  __line__
27])
28
29             
30define([_endsubp],[
31        _endfn(_SP$1)
32# __line__
33])
34
35       
36               
37define([jump_builtin],[
38        ref_nrs_value(fname,builtin_functions)
39        set_nargs($2)
40        vrefr(fname,fname,$1)
41        jump_fname()
42])
43       
44_spentry(jmpsym)
45        __(jump_fname())
46       
47_spentry(jmpnfn)
48        __(jump_nfn())
49       
50        /* Call temp0 if it's either a symbol or function */
51_spentry(funcall)
52        __(do_funcall())
53       
54/* Subprims for catch, throw, unwind_protect. */
55
56/* Push a catch frame on the temp stack (and some of it on the cstack, as well.) */
57/* The PC in question is 4 bytes past the caller's return address. ALWAYS. */
58/* The catch tag is in arg_z, the multiple-value flags is in imm2. */
59/* Bash some of the imm registers and loc_pc. */
60
61_spentry(mkcatch1v)
62        __(li imm2,0)
63        __(mkcatch())
64
65_spentry(mkunwind)
66        __(lwi(arg_z,unbound_marker))
67        __(li imm2,fixnum_one)
68        __(mkcatch())
69       
70_spentry(mkcatchmv)
71        __(li imm2,fixnum_one)
72        __(mkcatch())
73
74/* Caller has pushed tag and 0 or more values; nargs = nvalues. */
75/* Otherwise, process unwind-protects and throw to indicated catch frame. */
76       
77_spentry(throw)
78        __(ldr(imm1,tcr.catch_top(rcontext)))
79        __(li imm0,0) /* count intervening catch/unwind-protect frames. */
80        __(cmpri(cr0,imm1,0))
81        __(ldrx(temp0,vsp,nargs))
82        __(beq- cr0,local_label(_throw_tag_not_found))
83local_label(_throw_loop):
84        __(ldr(temp1,catch_frame.catch_tag(imm1)))
85        __(cmpr(cr0,temp0,temp1))
86        __(mr imm2,imm1)
87        __(ldr(imm1,catch_frame.link(imm1)))
88        __(cmpri(cr1,imm1,0))
89        __(beq cr0,local_label(_throw_found))
90        __(addi imm0,imm0,fixnum_one)
91        __(beq- cr1,local_label(_throw_tag_not_found))
92        __(b local_label(_throw_loop))
93/* imm2: (tstack-consed) target catch frame, imm0: count of intervening frames.
94  If target isn't a multiple-value receiver, discard extra values
95  (less hair, maybe.) */
96local_label(_throw_found):
97        __(ldr(imm1,catch_frame.mvflag(imm2)))
98        __(cmpri(cr0,imm1,0))
99        __(cmpri(cr1,nargs,0))
100        __(li fn,0)
101        __(add imm1,vsp,nargs)
102        __(la imm1,-4(imm1))
103        __(bne cr0,local_label(_throw_all_values))
104        __(set_nargs(1))
105        __(beq cr1,local_label(_throw_default_1_val))
106        __(mr vsp,imm1)
107        __(b local_label(_throw_all_values))
108local_label(_throw_default_1_val):
109        __(li imm4,nil_value)
110        __(vpush(imm4))
111local_label(_throw_all_values):
112        __(bl _SPnthrowvalues)
113        __(ldr(imm3,tcr.catch_top(rcontext)))
114        __(ldr(imm1,tcr.db_link(rcontext)))
115        __(ldr(imm0,catch_frame.db_link(imm3)))
116        __(ldr(imm4,catch_frame.mvflag(imm3)))
117        __(cmpr(cr0,imm0,imm1))
118        __(cmpri(cr1,imm4,0))
119        __(la tsp,-(fulltag_misc+8)(imm3))
120        __(beq cr0,local_label(_throw_dont_unbind))
121        __(bl _SPsvar_unbind_to)
122local_label(_throw_dont_unbind):
123        __(add imm0,vsp,nargs)
124        __(cmpri(cr0,nargs,0))
125        __(ldr(imm1,catch_frame.csp(imm3)))
126        __(ldr(imm1,lisp_frame.savevsp(imm1)))
127        __(bne cr1,local_label(_throw_multiple))
128/* Catcher expects single value in arg_z */
129        __(ldr(arg_z,-4(imm0)))
130        __(b local_label(_throw_pushed_values))
131local_label(_throw_multiple):
132        __(beq cr0,local_label(_throw_pushed_values))
133        __(mr imm2,nargs)
134local_label(_throw_mvloop):
135        __(subi imm2,imm2,fixnum_one)
136        __(cmpri(imm2,0))
137        __(lwzu temp0,-4(imm0))
138        __(push(temp0,imm1))
139        __(bgt local_label(_throw_mvloop))
140local_label(_throw_pushed_values):
141        __(mr vsp,imm1)
142        __(ldr(sp,catch_frame.csp(imm3)))
143        __(ldr(fn,lisp_frame.savefn(sp)))
144        __(ldr(loc_pc,lisp_frame.savelr(sp)))
145        __(discard_lisp_frame())
146        __(mtlr loc_pc)
147        __(lmw first_nvr,catch_frame.regs(imm3))
148        __(ldr(imm1,catch_frame.xframe(imm3)))
149        __(str(imm1,tcr.xframe(rcontext)))
150        __(ldr(imm3,catch_frame.link(imm3)))
151        __(str(imm3,tcr.catch_top(rcontext)))
152        __(unlink(tsp))
153        __(blr)
154local_label(_throw_tag_not_found):
155        __(uuo_interr(error_throw_tag_missing,temp0))
156        __(strux(temp0,vsp,nargs))
157        __(b _SPthrow)
158
159
160/* This takes N multiple values atop the vstack. */
161_spentry(nthrowvalues)
162        __(mr imm4,imm0)
163local_label(_nthrowv_nextframe):
164        __(subi imm4,imm4,fixnum_one)
165        __(cmpri(cr1,imm4,0))
166        __(ldr(temp0,tcr.catch_top(rcontext)))
167        __(ldr(imm1,tcr.db_link(rcontext)))
168        __(bltlr cr1)
169        __(ldr(imm0,catch_frame.db_link(temp0)))
170        __(ldr(imm3,catch_frame.link(temp0)))
171        __(cmpr(cr0,imm0,imm1))
172        __(str(imm3,tcr.catch_top(rcontext)))
173        __(ldr(temp1,catch_frame.catch_tag(temp0)))
174        __(cmpri(cr7,temp1,unbound_marker))             /* unwind-protect ? */
175        __(ldr(sp,catch_frame.csp(temp0)))
176        __(beq cr0,local_label(_nthrowv_dont_unbind))
177        __(mflr loc_pc)
178        __(bl _SPsvar_unbind_to)
179        __(mtlr loc_pc)
180local_label(_nthrowv_dont_unbind):
181        __(beq cr7,local_label(_nthrowv_do_unwind))
182/* A catch frame.  If the last one, restore context from there. */
183        __(bne cr1,local_label(_nthrowv_skip))
184        __(ldr(first_nvr,catch_frame.xframe(temp0)))
185        __(str(first_nvr,tcr.xframe(rcontext)))
186        __(ldr(imm0,lisp_frame.savevsp(sp)))
187        __(str(rzero,lisp_frame.savevsp(sp)))   /* marker for stack overflow code */
188        __(add imm1,vsp,nargs)
189        __(mr imm2,nargs)
190        __(b local_label(_nthrowv_push_test))
191local_label(_nthrowv_push_loop):
192        __(lwzu temp1,-4(imm1))
193        __(push(temp1,imm0))
194local_label(_nthrowv_push_test):
195        __(cmpri(imm2,0))
196        __(subi imm2,imm2,fixnum_one)
197        __(bne local_label(_nthrowv_push_loop))
198        __(mr vsp,imm0)
199        __(lmw first_nvr,catch_frame.regs(temp0))
200
201local_label(_nthrowv_skip):
202        __(la tsp,-(8+fulltag_misc)(temp0))
203        __(unlink(tsp))
204        __(discard_lisp_frame())
205        __(b local_label(_nthrowv_nextframe))
206local_label(_nthrowv_do_unwind):
207/* This is harder.  Call the cleanup code with the multiple values (and */
208/* nargs, which is a fixnum.)  Remember the throw count (also a fixnum) */
209/* as well. */
210/* Save our caller's LR and FN in the csp frame created by the unwind- */
211/* protect.  (Clever, eh ?) */
212        __(ldr(first_nvr,catch_frame.xframe(temp0)))
213        __(str(first_nvr,tcr.xframe(rcontext)))
214        __(lmw first_nvr,catch_frame.regs(temp0))
215        __(la tsp,-(8+fulltag_misc)(temp0))
216        __(unlink(tsp))
217        __(ldr(loc_pc,lisp_frame.savelr(sp)))
218        __(ldr(nfn,lisp_frame.savefn(sp)))
219        __(mtctr loc_pc)        /* cleanup code address. */
220        __(str(fn,lisp_frame.savefn(sp)))
221        __(mflr loc_pc)
222        __(mr fn,nfn)
223        __(str(loc_pc,lisp_frame.savelr(sp)))
224        __(dnode_align(imm0,nargs,tsp_frame.fixed_overhead+8))  /* tsp overhead, nargs, throw count */
225        __(TSP_Alloc_Var_Boxed_nz(imm0,imm1))
226        __(mr imm2,nargs)
227        __(add imm1,nargs,vsp)
228        __(ldr(imm0,tsp_frame.backlink(tsp)))                      /* end of tsp frame */
229        __(str(rzero,-4(imm0)))
230        __(la imm0,tsp_frame.data_offset(tsp))
231        __(str(nargs,0(imm0)))
232        __(b local_label(_nthrowv_tpushtest))
233local_label(_nthrowv_tpushloop):
234        __(lwzu temp0,-4(imm1))
235        __(stru(temp0,4(imm0)))
236        __(subi imm2,imm2,fixnum_one)
237local_label(_nthrowv_tpushtest):
238        __(cmpri(imm2,0))
239        __(bne local_label(_nthrowv_tpushloop))
240        __(stru(imm4,4(imm0)))
241        __(ldr(vsp,lisp_frame.savevsp(sp)))
242        __(str(rzero,lisp_frame.savevsp(sp)))       /* tell stack overflow code to skip this frame */
243        __(bctrl)
244        __(la imm0,tsp_frame.data_offset(tsp))
245        __(ldr(fn,lisp_frame.savefn(sp)))
246        __(ldr(loc_pc,lisp_frame.savelr(sp)))
247        __(discard_lisp_frame())
248        __(mtlr loc_pc)
249        __(ldr(nargs,0(imm0)))
250        __(mr imm2,nargs)
251        __(b local_label(_nthrowv_tpoptest))
252local_label(_nthrowv_tpoploop):
253        __(lwzu temp0,4(imm0))
254        __(vpush(temp0))
255        __(subi imm2,imm2,fixnum_one)
256local_label(_nthrowv_tpoptest):
257        __(cmpri(imm2,0))
258        __(bne local_label(_nthrowv_tpoploop))
259        __(ldr(imm4,4(imm0)))
260        __(unlink(tsp))
261        __(b local_label(_nthrowv_nextframe))
262
263
264/* This is a (slight) optimization.  When running an unwind-protect, */
265/* save the single value and the throw count in the tstack frame. */
266/* Note that this takes a single value in arg_z. */
267_spentry(nthrow1value)
268        __(mr imm4,imm0)
269local_label(_nthrow1v_nextframe):
270        __(subi imm4,imm4,fixnum_one)
271        __(cmpri(cr1,imm4,0))
272        __(ldr(temp0,tcr.catch_top(rcontext)))
273        __(ldr(imm1,tcr.db_link(rcontext)))
274        __(set_nargs(1))
275        __(bltlr cr1)
276        __(ldr(imm3,catch_frame.link(temp0)))
277        __(ldr(imm0,catch_frame.db_link(temp0)))
278        __(cmpr(cr0,imm0,imm1))
279        __(str(imm3,tcr.catch_top(rcontext)))
280        __(ldr(temp1,catch_frame.catch_tag(temp0)))
281        __(cmpri(cr7,temp1,unbound_marker))             /* unwind-protect ? */
282        __(ldr(sp,catch_frame.csp(temp0)))
283        __(beq cr0,local_label(_nthrow1v_dont_unbind))
284         __(mflr loc_pc)
285         __(bl _SPsvar_unbind_to)
286         __(mtlr loc_pc)
287local_label(_nthrow1v_dont_unbind):
288        __(beq cr7,local_label(_nthrow1v_do_unwind))
289/* A catch frame.  If the last one, restore context from there. */
290        __(bne cr1,local_label(_nthrow1v_skip))
291        __(ldr(vsp,lisp_frame.savevsp(sp)))
292        __(ldr(first_nvr,catch_frame.xframe(temp0)))
293        __(str(first_nvr,tcr.xframe(rcontext)))
294        __(lmw first_nvr,catch_frame.regs(temp0))
295local_label(_nthrow1v_skip):
296        __(la tsp,-(tsp_frame.fixed_overhead+fulltag_misc)(temp0))
297        __(unlink(tsp))
298        __(discard_lisp_frame())
299        __(b local_label(_nthrow1v_nextframe))
300local_label(_nthrow1v_do_unwind):
301/* This is harder, but not as hard (not as much BLTing) as the */
302/* multiple-value case. */
303
304/* Save our caller's LR and FN in the csp frame created by the unwind- */
305/* protect.  (Clever, eh ?) */
306
307        __(ldr(first_nvr,catch_frame.xframe(temp0)))
308        __(str(first_nvr,tcr.xframe(rcontext)))
309        __(lmw first_nvr,catch_frame.regs(temp0))
310        __(la tsp,-(tsp_frame.fixed_overhead+fulltag_misc)(temp0))
311        __(unlink(tsp))
312        __(ldr(loc_pc,lisp_frame.savelr(sp)))
313        __(ldr(nfn,lisp_frame.savefn(sp)))
314        __(mtctr loc_pc)                /* cleanup code address. */
315        __(str(fn,lisp_frame.savefn(sp)))
316        __(mflr loc_pc)
317        __(mr fn,nfn)
318        __(str(loc_pc,lisp_frame.savelr(sp)))
319        __(TSP_Alloc_Fixed_Boxed(8)) /* tsp overhead, value, throw count */
320        __(str(arg_z,tsp_frame.data_offset(tsp)))
321        __(str(imm4,tsp_frame.data_offset+4(tsp)))
322        __(ldr(vsp,lisp_frame.savevsp(sp)))
323        __(str(rzero,lisp_frame.savevsp(sp)))       /* Tell stack overflow code to ignore this frame */
324        __(bctrl)
325        __(ldr(arg_z,tsp_frame.data_offset(tsp)))
326        __(ldr(imm4,tsp_frame.data_offset+4(tsp)))
327        __(ldr(fn,lisp_frame.savefn(sp)))
328        __(ldr(loc_pc,lisp_frame.savelr(sp)))
329        __(discard_lisp_frame())
330        __(mtlr loc_pc)
331        __(unlink(tsp))
332        __(b local_label(_nthrow1v_nextframe))
333
334
335
336_spentry(req_stack_restv_arg)
337       
338_spentry(stack_cons_restv_arg)
339
340_spentry(stack_restv_arg)
341       
342
343_spentry(vspreadargz)
344
345
346/* Undo N special bindings: imm0 = n, unboxed and >0. */
347_spentry(unbind_n)
348        __(ldr(imm1,tcr.db_link(rcontext)))
3491:
350        __(cmpri(cr0,imm0,1))
351        __(subi imm0,imm0,1)
352        __(ldr(imm1,0(imm1)))
353        __(bne cr0,1b)
354        __(str(imm1,tcr.db_link(rcontext)))
355        __(blr)
356
357/* Unwind special bindings until the head of the linked list = imm0. */
358_spentry(unbind_to)
359        __(str(imm0,tcr.db_link(rcontext)))
360        __(blr)
361
362_spentry(conslist)
363        __(li arg_z,nil_value)
364        __(cmpri(nargs,0))
365        __(b 2f)       
3661:
367        __(ldr(temp0,0(vsp)))
368        __(cmpri(nargs,fixnum_one))
369        __(la vsp,4(vsp))
370        __(Cons(arg_z,temp0,arg_z))
371        __(subi nargs,nargs,fixnum_one)
3722:
373        __(bne 1b)
374        __(blr)
375       
376/* do list*: last arg in arg_z, all others vpushed, nargs set to #args vpushed. */
377/* Cons, one cons cell at at time.  Maybe optimize this later. */
378_spentry(conslist_star)
379        __(cmpri(nargs,0))
380        __(b 2f)       
3811:
382        __(ldr(temp0,0(vsp)))
383        __(cmpri(nargs,fixnum_one))
384        __(la vsp,4(vsp))
385        __(Cons(arg_z,temp0,arg_z))
386        __(subi nargs,nargs,fixnum_one)
3872:
388        __(bne 1b)
389        __(blr)
390
391/* We always have to create a tsp frame (even if nargs is 0), so the compiler
392   doesn't get confused. */
393_spentry(stkconslist)
394        __(li arg_z,nil_value)
395        __(cmpri(cr1,nargs,0))
396        __(add imm1,nargs,nargs)
397        __(addi imm1,imm1,tsp_frame.fixed_overhead)
398        __(TSP_Alloc_Var_Boxed(imm1,imm2))
399        __(la imm1,tsp_frame.data_offset+fulltag_cons(tsp))
400        __(b 2f)
4011:      __(ldr(temp0,0(vsp)))
402        __(cmpri(cr1,nargs,fixnum_one))
403        __(la vsp,4(vsp))
404        __(rplaca(imm1,temp0))
405        __(rplacd(imm1,arg_z))
406        __(mr arg_z,imm1)
407        __(la imm1,cons.size(imm1))
408        __(la nargs,-fixnum_one(nargs))
4092:
410        __(bne cr1,1b)
411        __(blr)
412
413/* do list*: last arg in arg_z, all others vpushed, 
414        nargs set to #args vpushed. */
415_spentry(stkconslist_star)
416        __(cmpri(cr1,nargs,0))
417        __(add imm1,nargs,nargs)
418        __(addi imm1,imm1,tsp_frame.fixed_overhead)
419        __(TSP_Alloc_Var_Boxed(imm1,imm2))
420        __(la imm1,tsp_frame.data_offset+fulltag_cons(tsp))
421        __(b 2f)
4221:      __(ldr(temp0,0(vsp)))
423        __(cmpri(cr1,nargs,fixnum_one))
424        __(la vsp,4(vsp))
425        __(rplaca(imm1,temp0))
426        __(rplacd(imm1,arg_z))
427        __(mr arg_z,imm1)
428        __(la imm1,cons.size(imm1))
429        __(la nargs,-fixnum_one(nargs))
4302:
431        __(bne cr1,1b)
432        __(blr)
433
434
435/* Make a stack-consed simple-vector out of the NARGS objects
436        on top of the vstack; return it in arg_z. */
437_spentry(mkstackv)
438        __(cmpri(cr1,nargs,0))
439        __(dnode_align(imm1,nargs,tsp_frame.fixed_overhead+node_size))
440        __(TSP_Alloc_Var_Boxed_nz(imm1,imm2))
441        __(slwi imm0,nargs,num_subtag_bits-fixnumshift)
442        __(ori imm0,imm0,subtag_simple_vector)
443        __(str(imm0,tsp_frame.data_offset(tsp)))
444        __(la arg_z,tsp_frame.data_offset+fulltag_misc(tsp))
445        __(beq- cr1,2f)
446        __(la imm0,misc_data_offset(arg_z))
447        __(add imm1,imm0,nargs)
4481:
449        __(la nargs,-4(nargs))
450        __(cmpri(cr1,nargs,0))
451        __(ldr(temp1,0(vsp)))
452        __(la vsp,4(vsp))
453        __(stwu temp1,-4(imm1))
454        __(bne cr1,1b)
4552:
456        __(blr)
457
458       
459/* like misc_ref, only the boxed subtag is in arg_x.
460*/
461_spentry(subtag_misc_ref)
462        __(trap_unless_fulltag_equal(arg_y,fulltag_misc,imm0))
463        __(trap_unless_lisptag_equal(arg_z,tag_fixnum,imm0))
464        __(vector_length(imm0,arg_y,imm1))
465        __(trlge(arg_z,imm0))
466        __(unbox_fixnum(imm1,arg_x))
467        __(b misc_ref_common)
468       
469
470/* Is it worth trying to avoid (postpone) consing here ? */
471_spentry(newblocktag)
472        __(li imm1,lisp_globals.block_tag_counter)
4731:             
474        __(lwarx imm0,0,imm1)
475        __(addi imm0,imm0,1<<num_subtag_bits)
476        __(cmpri(imm0,0))
477        __(ori arg_z,imm0,subtag_block_tag)
478        __(beq- local_label(cons_nil_nil))
479        __(stwcx. imm0,0,imm1)
480        __(bne- 1b)
481        __(isync)
482        __(blr)
483       
484_spentry(newgotag)
485        __(li imm1,lisp_globals.go_tag_counter)
4861:      __(lwarx imm0,0,imm1)
487        __(addi imm0,imm0,1<<num_subtag_bits)
488        __(cmpri(imm0,0))
489        __(ori arg_z,imm0,subtag_go_tag)
490        __(beq- local_label(cons_nil_nil))
491        __(stwcx. imm0,0,imm1)
492        __(bne- 1b)
493        __(isync)
494        __(blr)
495local_label(cons_nil_nil):
496        __(li imm2,RESERVATION_DISCHARGE)
497        __(stwcx. imm2,0,imm2)
498        __(li imm0,nil_value)
499        __(Cons(arg_z,imm0,imm0))
500        __(blr)
501
502       
503/* Allocate a miscobj on the temp stack.  (Push a frame on the tsp and
504   heap-cons the object if there's no room on the tstack.) */
505_spentry(stack_misc_alloc)
506        __(rlwinm. imm2,arg_y,32-fixnumshift,0,(8+fixnumshift)-1)
507        __(unbox_fixnum(imm0,arg_z))
508        __(extract_fulltag(imm1,imm0))
509        __(bne- cr0,9f)
510        __(cmpri(cr0,imm1,fulltag_nodeheader))
511        __(mr imm3,imm0)
512        __(cmplri(cr1,imm0,max_32_bit_ivector_subtag))
513        __(rlwimi imm0,arg_y,num_subtag_bits-fixnum_shift,0,31-num_subtag_bits) /* imm0 now = header */
514        __(mr imm2,arg_y)
515        __(beq cr0,1f)  /* do probe if node object
516                           (fixnum element count = byte count). */
517        __(cmplri(cr0,imm3,max_16_bit_ivector_subtag))
518        __(bng cr1,1f) /* do probe if 32-bit imm object */
519        __(cmplri(cr1,imm3,max_8_bit_ivector_subtag))
520        __(srwi imm2,imm2,1)
521        __(bgt cr0,3f)
522        __(bgt cr1,1f)
523        __(srwi imm2,imm2,1)
524/* imm2 now = byte count.  Add 4 for header, 7 to align, then
525        clear low three bits. */
5261:
527        __(dnode_align(imm3,imm2,tsp_frame.fixed_overhead+node_size))
528        __(cmplri(cr0,imm3,tstack_alloc_limit)) /* more than limit ? */
529        __(bgt- cr0,0f)
530        __(TSP_Alloc_Var_Boxed_nz(imm3,imm4))
531
532/* Slap the header on the vector, then return. */
533        __(str(imm0,tsp_frame.data_offset(tsp)))
534        __(la arg_z,tsp_frame.data_offset+fulltag_misc(tsp))
535        __(blr)
5369:
537
538
539
540/* Too large to safely fit on tstack.  Heap-cons the vector, but make
541   sure that there's an empty tsp frame to keep the compiler happy. */
5420:
543        __(TSP_Alloc_Fixed_Unboxed(0))
544        __(b _SPmisc_alloc)
5453:
546        __(cmplri(imm3,subtag_double_float_vector))
547        __(slwi imm2,arg_y,1)
548        __(beq 1b)
549        __(addi imm2,arg_y,7<<fixnumshift)
550        __(srwi imm2,imm2,fixnumshift+3)
551        __(b 1b)
552
553/* subtype (boxed, of course) is vpushed, followed by nargs bytes worth of */
554/* initial-contents.  Note that this can be used to cons any type of initialized */
555/* node-header'ed misc object (symbols, closures, ...) as well as vector-like */
556/* objects. */
557/* Note that we're guaranteed to win (or force GC, or run out of memory) */
558/* because nargs < 32K. */
559_spentry(gvector)
560        __(ldrx(arg_z,vsp,nargs))
561        __(unbox_fixnum(imm0,arg_z))
562        __(rlwimi imm0,nargs,num_subtag_bits-fixnum_shift,0,31-num_subtag_bits)
563        __(dnode_align(imm1,nargs,node_size))
564        __(Misc_Alloc(arg_z,imm0,imm1))
565        __(mr imm1,nargs)
566        __(addi imm2,imm1,misc_data_offset)
567        __(b 2f)
5681:
569        __(stwx temp0,arg_z,imm2)
5702:
571        __(subi imm1,imm1,node_size)
572        __(cmpri(cr0,imm1,0))
573        __(subi imm2,imm2,node_size)
574        __(vpop(temp0))         /* Note the intentional fencepost:
575                                      discard the subtype as well. */
576        __(bge cr0,1b)
577        __(blr)
578       
579        .globl C(nvalret)
580       
581        /* Come here with saved context on top of stack. */
582_spentry(nvalret)
583C(nvalret):     
584        __(ldr(loc_pc,lisp_frame.savelr(sp)))
585        __(ldr(temp0,lisp_frame.savevsp(sp)))
586        __(ldr(fn,lisp_frame.savefn(sp)))
587        __(discard_lisp_frame())
588        __(b local_label(return_values))
589       
590/* funcall temp0, returning multiple values if it does. */
591_spentry(mvpass)
592        __(cmpri(cr0,nargs,4*nargregs))
593        __(mflr loc_pc)
594        __(mr imm0,vsp)
595        __(ble+ cr0,1f)
596         __(subi imm0,imm0,4*nargregs)
597         __(add imm0,imm0,nargs)
5981:
599        __(build_lisp_frame(fn,loc_pc,imm0))
600        __(ref_global(loc_pc,ret1val_addr))
601        __(li fn,0)
602        __(mtlr loc_pc)
603        __(do_funcall())
604       
605/* ret1valn returns "1 multiple value" when a called function does not */
606/* return multiple values.  Its presence on the stack (as a return address) */
607/* identifies the stack frame to code which returns multiple values. */
608
609_exportfn(C(ret1valn))
610        __(ldr(loc_pc,lisp_frame.savelr(sp)))
611        __(ldr(vsp,lisp_frame.savevsp(sp)))
612        __(mtlr loc_pc)
613        __(ldr(fn,lisp_frame.savefn(sp)))
614        __(discard_lisp_frame())
615        __(vpush(arg_z))
616        __(set_nargs(1))
617        __(blr)
618       
619_spentry(fitvals)
620        __(subf. imm0,nargs,imm0)
621        __(li imm1,nil_value)
622        __(bge 2f)
623        __(sub vsp,vsp,imm0)
624        __(blr)
6251:
626        __(subic. imm0,imm0,4)
627        __(vpush(imm1))
628        __(addi nargs,nargs,4)
6292:
630        __(bne 1b)
631        __(blr)
632
633
634_spentry(nthvalue)
635        __(add imm0,vsp,nargs)
636        __(ldr(imm1,0(imm0)))
637        __(cmplr(imm1,nargs))   /*  do unsigned compare:         if (n < 0) => nil. */
638        __(li arg_z,nil_value)
639        __(neg imm1,imm1)
640        __(subi imm1,imm1,4)
641        __(bge 1f)
642        __(ldrx(arg_z,imm0,imm1))
6431:     
644        __(la vsp,4(imm0))
645        __(blr)
646       
647
648        /* Come here to return multiple values when */
649        /* the caller's context isn't saved in a lisp_frame. */
650        /* lr, fn valid; temp0 = entry vsp */
651
652_spentry(values)
653        __(mflr loc_pc)
654local_label(return_values):     
655        __(ref_global(imm0,ret1val_addr))
656        __(li arg_z,nil_value)
657        /* max tsp frame is 4K. 8+8 is overhead for save_values_to_tsp below */
658        /* and @do_unwind in nthrowvalues in "sp_catch.s". */
659        __(cmpri(cr2,nargs,4096-(8+8)))
660        __(cmpr(cr1,imm0,loc_pc))
661        __(cmpri(cr0,nargs,fixnum_one))
662        __(bge cr2,2f)
663        __(beq+ cr1,3f)
664        __(mtlr loc_pc)
665        __(add imm0,nargs,vsp)
666        __(blt- cr0,1f)
667        __(ldr(arg_z,-4(imm0)))
6681:
669        __(mr vsp,temp0)
670        __(blr)
671
6722:
673        __(uuo_interr(error_too_many_values,nargs))
674        __(b 2b)
675
676/* Return multiple values to real caller. */
6773:
678        __(ldr(loc_pc,lisp_frame.savelr(sp)))
679        __(add imm1,nargs,vsp)
680        __(ldr(imm0,lisp_frame.savevsp(sp)))
681        __(ldr(fn,lisp_frame.savefn(sp)))
682        __(cmpr(cr0,imm1,imm0)) /* a fairly common case */
683        __(mtlr loc_pc)
684        __(cmpri(cr1,nargs,fixnum_one)) /* sadly, a very common case */
685        __(discard_lisp_frame())
686        __(beqlr cr0) /* already in the right place */
687        __(bne cr1,4f)
688         __(ldr(arg_z,0(vsp)))
689         __(mr vsp,imm0)
690         __(vpush(arg_z))
691         __(blr)
6924:
693        __(blt cr1,6f)
694        __(li imm2,fixnum_one)
6955:
696        __(cmpr(cr0,imm2,nargs))
697        __(addi imm2,imm2,fixnum_one)
698        __(lwzu arg_z,-4(imm1))
699        __(push(arg_z,imm0))
700        __(bne cr0,5b)
7016:
702        __(mr vsp,imm0)
703        __(blr)
704       
705/* Provide default (NIL) values for &optional arguments; imm0 is
706   the (fixnum) upper limit on the total of required and &optional
707   arguments.  nargs is preserved, all arguments wind up on the
708   vstack. */
709_spentry(default_optional_args)
710        __(cmplr( cr7,nargs,imm0))
711        __(li imm5,nil_value)
712        __(vpush_argregs())
713        __(mr imm1,nargs)
714        __(bgelr cr7)
7151:     
716        __(addi imm1,imm1,fixnum_one)
717        __(cmpr(cr0,imm1,imm0))
718        __(vpush(imm5))
719        __(bne cr0,1b)
720        __(blr)
721       
722/* Indicate whether &optional arguments were actually supplied.  nargs
723   contains the actual arg count (minus the number of required args); 
724   imm0 contains the number of &optional args in the lambda list.
725   Note that nargs may be > imm0 if &rest/&key is involved. */
726_spentry(opt_supplied_p)
727        __(li imm1,0)
7281:
729        /* (vpush (< imm1 nargs)) */
730        __(xor imm2,imm1,nargs)
731        __(srawi imm2,imm2,31)
732        __(or imm2,imm2,imm1)
733        __(addi imm1,imm1,fixnumone)
734        __(cmpr(cr0,imm1,imm0))
735        __(subf imm2,nargs,imm2)
736        __(srwi imm2,imm2,31)
737        __(insrwi imm2,imm2,1,27)
738        __(addi imm2,imm2,nil_value)
739        __(vpush(imm2))
740        __(bne cr0,1b)
741        __(blr)
742       
743
744
745/* If nargs is <= imm0, vpush a nil.  Otherwise, cons a list of length
746   (- nargs imm0) and vpush it.
747   Use this entry point to heap-cons a simple &rest arg. */
748_spentry(heap_rest_arg)
749        __(li imm0,0)
750        __(vpush_argregs())
751        __(sub imm1,nargs,imm0)
752        __(cmpri(imm1,0))
753        __(li arg_z,nil_value)
754        __(b 2f)
7551:
756        __(ldr(temp0,0(vsp)))
757        __(cmpri(imm1,fixnum_one))
758        __(la vsp,4(vsp))
759        __(Cons(arg_z,temp0,arg_z))
760        __(subi imm1,imm1,fixnum_one)
7612:
762        __(bgt 1b)
763        __(vpush(arg_z))
764        __(blr)
765
766       
767/* And this entry point when the argument registers haven't yet been
768   vpushed (as is typically the case when required/&rest but no &optional/&key.) */
769_spentry(req_heap_rest_arg)
770        __(vpush_argregs())
771        __(sub imm1,nargs,imm0)
772        __(cmpri(imm1,0))
773        __(li arg_z,nil_value)
774        __(b 2f)
7751:
776        __(ldr(temp0,0(vsp)))
777        __(cmpri(imm1,fixnum_one))
778        __(la vsp,4(vsp))
779        __(Cons(arg_z,temp0,arg_z))
780        __(subi imm1,imm1,fixnum_one)
7812:
782        __(bgt 1b)
783        __(vpush(arg_z))
784        __(blr)
785
786
787_spentry(heap_cons_rest_arg)
788        __(sub imm1,nargs,imm0)
789        __(cmpri(imm1,0))
790        __(li arg_z,nil_value)
791        __(b 2f)
7921:
793        __(ldr(temp0,0(vsp)))
794        __(cmpri(imm1,fixnum_one))
795        __(la vsp,4(vsp))
796        __(Cons(arg_z,temp0,arg_z))
797        __(subi imm1,imm1,fixnum_one)
7982:
799        __(bgt 1b)
800        __(vpush(arg_z))
801        __(blr)
802
803       
804_spentry(simple_keywords)
805        __(li imm0,0)
806        __(vpush_argregs())
807        __(b _SPkeyword_bind)
808               
809_spentry(keyword_args)
810        __(vpush_argregs())
811        __(b _SPkeyword_bind)
812
813/* Treat the last (- nargs imm0) values on the vstack as keyword/value
814   pairs.  There'll be imm3 keyword arguments.  Imm2 contains flags
815   that indicate whether &allow-other-keys was specified and whether
816   or not to leave the keyword/value pairs on the vstack for an &rest
817   argument.  Temp3 contains a vector of keyword specifiers which we
818   must (in general) match.
819   If the number of arguments is greater than imm0, the difference must
820   be even.
821   Note that the caller hasn't yet saved its caller's context and that
822   the temp registers used to pass closure_data (temp0) and next_method_context
823   (temp1) may still have "live" values in them, as does nfn (temp2). */
824
825define([keyword_flags],[imm2])
826define([keyword_vector],[temp3])
827define([keyword_count],[imm3])
828
829
830
831define([varptr],[save0])
832define([valptr],[save1])
833define([limit],[save2])
834
835_spentry(keyword_bind)
836        /* Before we can really do anything, we have to */
837        /* save the caller's context.  To do so, we need to know */
838        /* how many args have actually been pushed.  Ordinarily, that'd */
839        /* be "nargs", but we may have pushed more args than we received */
840        /* if we had to default any &optionals. */
841        /* So, the number of args pushed so far is the larger of nargs */
842        /* and the (canonical) total of required/&optional args received. */
843        __(cmpr(cr0,nargs,imm0))
844        __(add arg_z,vsp,nargs)
845        __(bge+ cr0,1f)
846        __(add arg_z,vsp,imm0)
8471:
848        __(build_lisp_frame(fn,loc_pc,arg_z))
849        __(mr fn,nfn)
850        /* If there are key/value pairs to consider, we slide them down */
851        /* the vstack to make room for the value/supplied-p pairs. */
852        /* The first step in that operation involves pushing imm3 pairs */
853        /* of NILs. */
854        /* If there aren't any such pairs, the first step is the last */
855        /* step. */
856        __(cmpri(cr0,imm3,0))
857        __(li arg_z,0)
858        __(sub imm1,nargs,imm0)
859        __(mr imm4,vsp) /* in case odd keywords error */
860        __(cmpri(cr1,imm1,0))
861        __(b 3f)
8622:
863        __(addi arg_z,arg_z,fixnum_one)
864        __(cmplr(cr0,arg_z,imm3))
865        __(li imm5,nil_value)
866        __(vpush(imm5))
867        __(vpush(imm5))
8683:
869        __(bne cr0,2b)
870        __(andi. arg_z,imm1,fixnum_one)
871        __(blelr cr1)   /* no keyword/value pairs to consider. */
872        __(bne cr0,odd_keywords)
873        /* We have key/value pairs.  Move them to the top of the vstack, */
874        /* then set the value/supplied-p vars to NIL. */
875        /* Have to use some save regs to do this. */
876        __(vpush(limit))
877        __(vpush(valptr))
878        __(vpush(varptr))
879        /* recompute ptr to user args in case stack overflowed */
880        __(add imm4,vsp,imm3)
881        __(add imm4,imm4,imm3)
882        __(addi imm4,imm4,12)
883        /* error if odd number of keyword/value args */
884        __(mr varptr,imm4)
885        __(la limit,12(vsp))
886        __(mr valptr,limit)
887        __(mr arg_z,imm1)
8884:
889        __(li imm4,nil_value)
890        __(subi arg_z,arg_z,2<<fixnumshift)
891        __(cmplri(cr0,arg_z,0))
892        __(ldr(arg_x,0(varptr)))
893        __(ldr(arg_y,4(varptr)))
894        __(str(imm4,0(varptr)))
895        __(str(imm4,4(varptr)))
896        __(la varptr,8(varptr))
897        __(str(arg_x,0(valptr)))
898        __(str(arg_y,4(valptr)))
899        __(la valptr,8(valptr))
900        __(bne cr0,4b)
901
902
903/* Now, iterate through each supplied keyword/value pair.  If
904   it's :allow-other-keys and the corresponding value is non-nil, 
905   note that other keys will be allowed.
906   Find its position in the function's keywords vector.  If that's
907   nil, note that an unknown keyword was encountered.
908   Otherwise, if the keyword arg hasn't already had a value supplied,
909   supply it.
910   When done, complain if any unknown keywords were found and that
911   situation was unexpected. */
912        __(mr imm4,valptr)
9135:
914        __(cmpwi cr0,keyword_flags,16<<fixnumshift) /* seen :a-o-k yet ? */
915        __(lwzu arg_z,-4(valptr))
916        __(lwzu arg_y,-4(valptr))
917        __(cmpri(cr1,arg_y,nil_value))
918        __(li arg_x,nrs.kallowotherkeys)
919        /* cr6_eq <- (eq current-keyword :allow-other-keys) */
920        __(cmpr(cr6,arg_x,arg_z))
921        __(cmpr(cr7,valptr,limit))
922        __(bne cr6,6f)
923        __(bge cr0,6f) /* Already seen :allow-other-keys */
924        __(ori keyword_flags,keyword_flags,16<<fixnumshift)
925        __(beq cr1,6f)
926        __(ori keyword_flags,keyword_flags,fixnum_one)
9276:
928        __(cmpri(cr1,imm3,0))
929        __(li imm1,misc_data_offset)
930        __(li imm0,0)
931        __(b 8f)
9327:
933        __(addi imm0,imm0,fixnum_one)
934        __(cmpr(cr1,imm0,imm3))
935        __(ldrx(arg_x,keyword_vector,imm1))
936        __(cmpr(cr0,arg_x,arg_z))
937        __(addi imm1,imm1,fixnum_one)
938        __(bne cr0,8f)
939        __(add imm0,imm0,imm0)
940        __(sub imm0,varptr,imm0)
941        __(ldr(arg_x,0(imm0)))
942        __(cmpri(cr0,arg_x,nil_value))
943        __(li arg_z,t_value)
944        __(bne cr0,9f)
945        __(str(arg_y,node_size(imm0)))
946        __(str(arg_z,0(imm0)))
947        __(b 9f)
9488:
949        __(bne cr1,7b)
950        /* Unknown keyword. If it was :allow-other-keys, cr6_eq will still
951           be set. */
952        __(beq cr6,9f)
953        __(ori keyword_flags,keyword_flags,2<<fixnumshift)
9549:
955        __(bne cr7,5b)
956        __(vpop(varptr))
957        __(vpop(valptr))
958        __(vpop(limit))
959        /* All keyword/value pairs have been processed. */
960        /* If we saw an unknown keyword and didn't expect to, error. */
961        /* Unless bit 2 is set in the fixnum in keyword_flags, discard the */
962        /* keyword/value pairs from the vstack. */
963        __(andi. imm0,keyword_flags,(fixnum_one)|(2<<fixnumshift))
964        __(cmpri(cr0,imm0,2<<fixnumshift))
965        __(beq- cr0,badkeys)
966        __(andi. imm2,keyword_flags,4<<fixnumshift)
967        __(bnelr cr0)
968        __(mr vsp,imm4)
969        __(blr)
970
971/* Signal an error.  We saved context on entry, so this thing doesn't
972   have to.
973   The "unknown keywords" error could be continuable (ignore them.)
974   It might be hard to then cons an &rest arg.
975   In the general case, it's hard to recover the set of args that were
976   actually supplied to us ... */
977        /* For now, just cons a list out of the keyword/value pairs */
978        /* that were actually provided, and signal an "invalid keywords" */
979        /* error with that list as an operand. */
980odd_keywords:
981        __(mr vsp,imm4)
982        __(mr nargs,imm1)
983        __(b 1f)
984badkeys:
985        __(sub nargs,imm4,vsp)
9861:
987        .globl _SPconslist
988        __(bl _SPconslist)
989        __(li arg_y,XBADKEYS)
990        __(set_nargs(2))
991        __(b _SPksignalerr)
992
993/*
994  A PowerOpen ff-call.  arg_z is either a fixnum (word-aligned entrypoint)
995  or a macptr (whose address had better be word-aligned as well.)  A
996  PowerOpen stack frame is on top of the stack; 4 additional words (to
997  be used a a lisp frame) sit under the C frame.
998
999  Since we probably can't deal with FP exceptions in foreign code, we
1000  disable them in the FPSCR, then check on return to see if any previously
1001  enabled FP exceptions occurred.
1002
1003  As it turns out, we can share a lot of code with the eabi version of
1004  ff-call.  Some things that happen up to the point of call differ between
1005  the ABIs, but everything that happens after is the same.
1006*/
1007       
1008_spentry(ffcall)
1009        __(mflr loc_pc)
1010        __(vpush_saveregs())            /* Now we can use save0-save7 to point to stacks */
1011        __(mr save0,rcontext)   /* or address globals. */
1012        __(extract_typecode(imm0,arg_z))
1013        __(cmpri(cr7,imm0,subtag_macptr))
1014        __(ldr(save1,0(sp)))    /* bottom of reserved lisp frame */
1015        __(la save2,-lisp_frame.size(save1))    /* top of lisp frame*/
1016        __(zero_doublewords save2,0,lisp_frame.size)
1017        __(str(save1,lisp_frame.backlink(save2)))
1018        __(str(save2,c_frame.backlink(sp)))
1019        __(str(fn,lisp_frame.savefn(save2)))
1020        __(str(loc_pc,lisp_frame.savelr(save2)))
1021        __(str(vsp,lisp_frame.savevsp(save2)))
1022        __(bne cr7,1f)
1023        __(ldr(arg_z,macptr.address(arg_z)))
10241:
1025        __(ldr(save3,tcr.cs_area(rcontext)))
1026        __(str(save2,area.active(save3)))
1027        __(str(allocptr,tcr.save_allocptr(rcontext)))
1028        __(str(allocbase,tcr.save_allocbase(rcontext)))
1029        __(str(tsp,tcr.save_tsp(rcontext)))
1030        __(str(vsp,tcr.save_vsp(rcontext)))
1031        __(str(rzero,tcr.ffi_exception(rcontext)))
1032        __(mffs f0)
1033        __(stfd f0,tcr.lisp_fpscr(rcontext))    /* remember lisp's fpscr */
1034        __(mtfsf 0xff,fp_zero)  /* zero foreign fpscr */
1035        __(li r4,TCR_STATE_FOREIGN)
1036        __(str(r4,tcr.valence(rcontext)))
1037        __(li rcontext,0)
1038        __(mtctr arg_z)
1039        __(ldr(r3,c_frame.param0(sp)))
1040        __(ldr(r4,c_frame.param1(sp)))
1041        __(ldr(r5,c_frame.param2(sp)))
1042        __(ldr(r6,c_frame.param3(sp)))
1043        __(ldr(r7,c_frame.param4(sp)))
1044        __(ldr(r8,c_frame.param5(sp)))
1045        __(ldr(r9,c_frame.param6(sp)))
1046        __(ldr(r10,c_frame.param7(sp)))
1047        /* Darwin is allegedly very picky about what register points
1048           to the function on entry. */
1049        __(mr r12,arg_z)
1050        __(bctrl)
1051        __(b _local_label(FF_call_return_common))
1052
1053_spentry(ffcalladdress)
1054        __(b _SPbreakpoint)
1055       
1056/* Signal an error synchronously, via %ERR-DISP. */
1057/* If %ERR-DISP isn't fbound, it'd be nice to print a message */
1058/* on the C runtime stderr. */
1059
1060_spentry(ksignalerr)
1061        __(li fname,nrs.errdisp)
1062        __(jump_fname)
1063       
1064/* As in the heap-consed cases, only stack-cons the &rest arg */
1065_spentry(stack_rest_arg)
1066        __(li imm0,0)
1067        __(vpush_argregs())
1068        __(b _SPstack_cons_rest_arg)
1069
1070       
1071_spentry(req_stack_rest_arg)
1072        __(vpush_argregs())
1073        __(b _SPstack_cons_rest_arg)
1074       
1075_spentry(stack_cons_rest_arg)
1076        __(sub imm1,nargs,imm0)
1077        __(cmpri(cr0,imm1,0))
1078        __(cmpri(cr1,imm1,(4096-8)/2))
1079        __(li arg_z,nil_value)
1080        __(ble cr0,2f)          /* always temp-push something. */
1081        __(bge cr1,3f)
1082        __(add imm1,imm1,imm1)
1083        __(dnode_align(imm2,imm1,tsp_frame.fixed_overhead))
1084        __(TSP_Alloc_Var_Boxed(imm2,imm3))
1085        __(la imm0,tsp_frame.data_offset+fulltag_cons(tsp))
10861:
1087        __(cmpri(cr0,imm1,8))   /* last time through ? */
1088        __(subi imm1,imm1,8)
1089        __(vpop(arg_x))
1090        __(rplacd(imm0,arg_z))
1091        __(rplaca(imm0,arg_x))
1092        __(mr arg_z,imm0)
1093        __(la imm0,cons.size(imm0))
1094        __(bne cr0,1b)
1095        __(vpush(arg_z))
1096        __(blr)
10972:
1098        __(TSP_Alloc_Fixed_Unboxed(0))
1099        __(vpush(arg_z))
1100        __(blr)
11013:
1102        __(TSP_Alloc_Fixed_Unboxed(0))
1103        __(b _SPheap_cons_rest_arg)
1104
1105
1106_spentry(callbackX)       
1107        /* Save C argument registers */
1108        __(str(r3,c_frame.param0(sp)))
1109        __(str(r4,c_frame.param1(sp)))
1110        __(str(r5,c_frame.param2(sp)))
1111        __(str(r6,c_frame.param3(sp)))
1112        __(str(r7,c_frame.param4(sp)))
1113        __(str(r8,c_frame.param5(sp)))
1114        __(str(r9,c_frame.param6(sp)))
1115        __(str(r10,c_frame.param7(sp)))
1116        __(mflr imm3)
1117        __(str(imm3,c_frame.savelr(sp)))
1118        __(mfcr imm0)
1119        __(str(imm0,c_frame.crsave(sp)))
1120
1121        /* Save the non-volatile registers on the sp stack */
1122        /* This is a non-standard stack frame, but noone will ever see it, */
1123        /* so it doesn't matter. It will look like more of the stack frame pushed below. */
1124        __(stru(sp,-(stack_align(c_reg_save.size))(sp)))
1125        __(stmw r13,c_reg_save.save_gprs(sp))
1126        __(check_stack_alignment(r0))
1127        __(mffs f0)
1128        __(stfd f0,c_reg_save.save_fp_zero(sp))
1129        __(ldr(r31,c_reg_save.save_fp_zero+4(sp)))      /* recover FPSCR image */
1130        __(str(r31,c_reg_save.save_fpscr(sp)))
1131        __(lwi(r30,0x43300000))
1132        __(lwi(r31,0x80000000))
1133        __(str(r30,c_reg_save.save_fp_zero(sp)))
1134        __(str(r31,c_reg_save.save_fp_zero+4(sp)))
1135        __(stfd fp_s32conv,c_reg_save.save_fps32conv(sp))
1136        __(lfd fp_s32conv,c_reg_save.save_fp_zero(sp))
1137        __(stfd fp_zero,c_reg_save.save_fp_zero(sp))
1138        __(lfs fp_zero,lisp_globals.short_float_zero(0))        /* ensure that fp_zero contains 0.0 */
1139
1140/* Restore rest of Lisp context. */
1141/* Could spread out the memory references here to gain a little speed */
1142
1143        __(li loc_pc,0)
1144        __(li fn,0)                     /* subprim, not a lisp function */
1145        __(li temp4,0)
1146        __(li temp3,0)
1147        __(li temp2,0)
1148        __(li temp1,0)
1149        __(li temp0,0)
1150        __(li arg_x,0)
1151        __(box_fixnum(arg_y,r11))       /* callback-index */
1152        __(la arg_z,stack_align(c_reg_save.size)+c_frame.param0(sp))    /* parameters (tagged as a fixnum) */
1153
1154        /* Recover lisp thread context. Have to call C code to do so. */
1155        __(ref_global(r12,get_tcr))
1156        __(mtctr r12)
1157        __(li r3,1)
1158        __(stru(sp,-(stack_align(c_frame.minsiz))(sp)))
1159        __(bctrl)
1160        __(mr rcontext,r3)
1161        /* re-establish lisp exception handling */
1162        __(ref_global(r12,lisp_return_hook))
1163        __(mtctr r12)
1164        __(bctrl)
1165        __(la sp,(stack_align(c_frame.minsiz))(sp))
1166
1167        __(ldr(vsp,tcr.save_vsp(rcontext)))
1168        __(ldr(tsp,tcr.save_tsp(rcontext)))             
1169        __(li rzero,0)
1170        __(mtxer rzero) /* lisp wants the overflow bit clear */
1171        __(li imm0,TCR_STATE_FOREIGN)
1172        __(li save0,0)
1173        __(li save1,0)
1174        __(li save2,0)
1175        __(li save3,0)
1176        __(li save4,0)
1177        __(li save5,0)
1178        __(li save6,0)
1179        __(li save7,0)
1180        __(lfd f0,tcr.lisp_fpscr(rcontext))
1181        __(mtfsf 0xff,f0)
1182        __(li allocptr,0)
1183        __(li allocbase,0)
1184        __(str(imm0,tcr.valence(rcontext)))
1185        __(ldr(allocptr,tcr.save_allocptr(rcontext)))
1186        __(ldr(allocbase,tcr.save_allocbase(rcontext)))
1187       
1188        /* load nargs and callback to the lisp */
1189        __(set_nargs(2))
1190        __(ldr(imm2,tcr.cs_area(rcontext)))
1191        __(ldr(imm4,area.active(imm2)))
1192        __(stru(imm4,-lisp_frame.size(sp)))
1193        __(str(imm3,lisp_frame.savelr(sp)))
1194        __(str(vsp,lisp_frame.savevsp(sp)))     /* for stack overflow code */
1195        __(li fname,nrs.callbacks)      /* %pascal-functions% */
1196        __(call_fname)
1197        __(ldr(imm2,lisp_frame.backlink(sp)))
1198        __(ldr(imm3,tcr.cs_area(rcontext)))
1199        __(str(imm2,area.active(imm3)))
1200        __(discard_lisp_frame())
1201        /* save_vsp will be restored from ff_call's stack frame, but */
1202        /* I included it here for consistency. */
1203        /* save_tsp is set below after we exit Lisp context. */
1204        __(str(allocptr,tcr.save_allocptr(rcontext)))
1205        __(str(allocbase,tcr.save_allocbase(rcontext)))
1206        __(str(vsp,tcr.save_vsp(rcontext)))
1207        __(str(tsp,tcr.save_tsp(rcontext)))
1208
1209        __(li imm1,TCR_STATE_FOREIGN)
1210        __(str(imm1,tcr.valence(rcontext)))
1211        __(mr r3,rcontext)
1212        __(ldr(r4,tcr.foreign_exception_status(rcontext)))
1213        __(cmpri(r4,0))
1214        /* Restore the non-volatile registers & fpscr */
1215        __(lfd fp_zero,c_reg_save.save_fp_zero(sp))
1216        __(ldr(r31,c_reg_save.save_fpscr(sp)))
1217        __(str(r31,c_reg_save.save_fp_zero+4(sp)))
1218        __(lfd f0,c_reg_save.save_fp_zero(sp))
1219        __(mtfsf 0xff,f0)
1220        __(lmw r13,c_reg_save.save_gprs(sp))
1221        __(lfd fp_s32conv,c_reg_save.save_fps32conv(sp))
1222        __(beq 9f)
1223        __(ref_global(r12,lisp_exit_hook))
1224        __(mtctr r12)
1225        __(bctrl)
12269:     
1227        __(ldr(sp,0(sp)))
1228        __(ldr(r3,c_frame.param0(sp)))
1229        __(ldr(r4,c_frame.param0(sp)))
1230        __(ldr(r5,c_frame.savelr(sp)))
1231        __(mtlr r5)
1232        __(ldr(r5,c_frame.crsave(sp)))
1233        __(mtcr r5)
1234        __(blr)
1235       
1236/* Prepend all but the first two (closure code, fn) and last two */
1237/* (function name, lfbits) elements of nfn to the "arglist". */
1238/* Doing things this way (the same way that 68K MCL does) lets */
1239/* functions which take "inherited arguments" work consistently */
1240/* even in cases where no closure object is created. */
1241_spentry(call_closure)       
1242        __(cmpri(cr0,nargs,nargregs<<fixnumshift))
1243        __(cmpri(cr1,nargs,fixnum_one))
1244        __(vector_length(imm0,nfn,imm0))
1245        __(subi imm0,imm0,4<<fixnumshift) /* imm0 = inherited arg count */
1246        __(li imm1,misc_data_offset+(2<<fixnumshift)) /* point to 1st arg */
1247        __(li imm4,nil_value)
1248        __(ble+ cr0,local_label(no_insert))
1249        /* Some arguments have already been vpushed.  Vpush imm0's worth */
1250        /* of NILs, copy those arguments that have already been vpushed from */
1251        /* the old TOS to the new, then insert all of the inerited args */
1252        /* and go to the function. */
1253        __(li imm2,0)
1254local_label(push_nil_loop):
1255        __(addi imm2,imm2,fixnum_one)
1256        __(cmpr(cr2,imm2,imm0))
1257        __(vpush(imm4))
1258        __(bne cr2,local_label(push_nil_loop))
1259
1260        __(mr imm3,vsp)
1261        __(add imm4,vsp,imm0)
1262        __(subi imm2,nargs,nargregs<<fixnumshift)
1263local_label(copy_already_loop):
1264        __(cmpri(cr2,imm2,fixnum_one))
1265        __(subi imm2,imm2,fixnum_one)
1266        __(ldr(fname,0(imm4)))
1267        __(addi imm4,imm4,fixnum_one)
1268        __(str(fname,0(imm3)))
1269        __(addi imm3,imm3,fixnum_one)
1270        __(bne cr2,local_label(copy_already_loop))
1271
1272local_label(insert_loop):
1273        __(cmpri(cr2,imm0,fixnum_one))
1274        __(ldrx(fname,nfn,imm1))
1275        __(addi imm1,imm1,fixnum_one)
1276        __(addi nargs,nargs,fixnum_one)
1277        __(subi imm0,imm0,fixnum_one)
1278        __(push(fname,imm4))
1279        __(bne cr2,local_label(insert_loop))
1280        __(b local_label(go))
1281local_label(no_insert):
1282        /* nargregs or fewer args were already vpushed. */
1283        /* if exactly nargregs, vpush remaining inherited vars. */
1284        __(add imm2,imm1,imm0)
1285        __(bne cr0,local_label(set_regs))
1286local_label(vpush_remaining):
1287        __(cmpri(cr2,imm0,fixnum_one))
1288        __(ldrx(fname,nfn,imm1))
1289        __(addi imm1,imm1,fixnum_one)
1290        __(vpush(fname))
1291        __(subi imm0,imm0,fixnum_one)
1292        __(addi nargs,nargs,fixnum_one)
1293        __(bne cr2,local_label(vpush_remaining))
1294        __(b local_label(go))
1295local_label(set_regs):
1296        /* if nargs was > 1 (and we know that it was < 3), it must have */
1297        /* been 2.  Set arg_x, then vpush the remaining args. */
1298        __(ble cr1,local_label(set_y_z))
1299local_label(set_arg_x):
1300        __(subi imm0,imm0,fixnum_one)
1301        __(cmpri(cr0,imm0,0))
1302        __(subi imm2,imm2,fixnum_one)
1303        __(ldrx(arg_x,nfn,imm2))
1304        __(addi nargs,nargs,fixnum_one)
1305        __(bne cr0,local_label(vpush_remaining))
1306        __(b local_label(go))
1307        /* Maybe set arg_y or arg_z, preceding args */
1308local_label(set_y_z):
1309        __(bne cr1,local_label(set_arg_z))
1310        /* Set arg_y, maybe arg_x, preceding args */
1311local_label(set_arg_y):
1312        __(subi imm0,imm0,fixnum_one)
1313        __(cmpri(cr0,imm0,0))
1314        __(subi imm2,imm2,fixnum_one)
1315        __(ldrx(arg_y,nfn,imm2))
1316        __(addi nargs,nargs,fixnum_one)
1317        __(bne cr0,local_label(set_arg_x))
1318        __(b local_label(go))
1319local_label(set_arg_z):
1320        __(subi imm0,imm0,fixnum_one)
1321        __(cmpri(cr0,imm0,0))
1322        __(subi imm2,imm2,fixnum_one)
1323        __(ldrx(arg_z,nfn,imm2))
1324        __(addi nargs,nargs,fixnum_one)
1325        __(bne cr0,local_label(set_arg_y))
1326
1327local_label(go):
1328        __(vrefr(nfn,nfn,1))
1329        __(ldr(loc_pc,_function.codevector(nfn)))
1330        __(mtctr loc_pc)
1331        __(bctr)
1332       
1333/*This (for better or worse) treats anything that's either */
1334/* (signed-byte 32), (unsigned-byte 32), (simple-base-string 4), or  */
1335/* (satisfies (lambda (s) (and (symbolp s) (typep (symbol-name s) '(simple-base-string 4))) */
1336/* as if it denoted a 32-bit value. */
1337/* Argument in arg_z, result in imm0.  May use temp0. */
1338_spentry(getxlong)
1339        __(extract_lisptag(imm0,arg_z))
1340        __(cmpri(cr0,imm0,tag_fixnum))
1341        __(cmpri(cr1,imm0,tag_misc))
1342        __(unbox_fixnum(imm0,arg_z))
1343        __(beqlr cr0)
1344        __(mr temp0,arg_z)
1345        __(bne- cr1,local_label(error))
1346        __(getvheader(imm0,temp0))
1347        __(cmpri(cr0,imm0,symbol_header))
1348        __(cmpri(cr1,imm0,one_digit_bignum_header))
1349        __(cmpri(cr7,imm0,two_digit_bignum_header))
1350        __(bne- cr0,local_label(not_sym))
1351        __(ldr(temp0,symbol.pname(arg_z)))
1352        __(getvheader(imm0,temp0))
1353local_label(not_sym):
1354        __(cmpri(cr0,imm0,(4<<num_subtag_bits)|subtag_simple_base_string))
1355        __(beq cr1,local_label(big1))
1356        __(beq cr0,local_label(big1))
1357        __(bne cr7,local_label(error))
1358
1359local_label(big2):
1360        __(vrefr(imm0,temp0,1)) /* sign digit must be 0 */
1361        __(cmpri(imm0,0))
1362        __(bne local_label(error))
1363local_label(big1):
1364        __(vrefr(imm0,temp0,0))
1365        __(blr)
1366
1367
1368local_label(error):
1369        __(uuo_interr(error_object_not_integer,arg_z)) /* not quite right but what 68K MCL said */
1370       
1371/* Everything up to the last arg has been vpushed, nargs is set to
1372   the (boxed) count of things already pushed.
1373   On exit, arg_x, arg_y, arg_z, and nargs are set as per a normal
1374   function call (this may require vpopping a few things.)
1375   ppc2-invoke-fn assumes that temp1 is preserved here. */
1376_spentry(spreadargz)
1377        __(extract_lisptag(imm1,arg_z))
1378        __(cmpri(cr1,imm1,tag_list))
1379        __(cmpri(cr0,arg_z,nil_value))
1380        __(li imm0,0)
1381        __(mr arg_y,arg_z)              /*  save in case of error */
1382        __(beq cr0,2f)
13831:
1384        __(bne- cr1,3f)
1385        __(_car(arg_x,arg_z))
1386        __(_cdr(arg_z,arg_z))
1387        __(cmpri(cr0,arg_z,nil_value))
1388        __(extract_lisptag(imm1,arg_z))
1389        __(cmpri(cr1,imm1,tag_list))
1390        __(vpush(arg_x))
1391        __(addi imm0,imm0,fixnum_one)
1392        __(bne cr0,1b)
13932:
1394        __(add. nargs,nargs,imm0)
1395        __(cmpri(cr2,nargs,2<<fixnumshift))
1396        __(beqlr- cr0)
1397        __(vpop(arg_z))
1398        __(bltlr cr2)
1399        __(vpop(arg_y))
1400        __(beqlr cr2)
1401        __(vpop(arg_x))
1402        __(blr)
1403/*  Discard whatever's been vpushed already, complain. */
14043:     
1405        __(add vsp,vsp,imm0)
1406        __(mr arg_z,arg_y)              /* recover original arg_z */
1407        __(li arg_y,XNOSPREAD)
1408        __(set_nargs(2))
1409        __(b _SPksignalerr)
1410
1411       
1412/* Tail-recursively funcall temp0. */
1413        /* Pretty much the same as the tcallsym* cases above. */
1414_spentry(tfuncallgen)
1415        __(cmpri(cr0,nargs,nargregs<<fixnumshift))
1416        __(ldr(loc_pc,lisp_frame.savelr(sp)))
1417        __(ldr(fn,lisp_frame.savefn(sp)))
1418        __(mtlr loc_pc)
1419        __(ble cr0,2f)
1420        __(ldr(imm0,lisp_frame.savevsp(sp)))
1421        __(discard_lisp_frame())
1422        /* can use nfn (= temp2) as a temporary */
1423        __(subi imm1,nargs,nargregs<<fixnumshift)
1424        __(add imm1,imm1,vsp)
14251:
1426        __(lwzu temp2,-4(imm1))
1427        __(cmpr(cr0,imm1,vsp))
1428        __(push(temp2,imm0))
1429        __(bne cr0,1b)
1430        __(mr vsp,imm0)
1431        __(do_funcall())
14322:
1433        __(ldr(vsp,lisp_frame.savevsp(sp)))
1434        __(discard_lisp_frame())
1435        __(do_funcall())
1436
1437
1438        /* Some args were vpushed.  Slide them down to the base of */
1439        /* the current frame, then do funcall. */
1440_spentry(tfuncallslide)
1441        __(ldr(loc_pc,lisp_frame.savelr(sp)))
1442        __(ldr(fn,lisp_frame.savefn(sp)))
1443        __(ldr(imm0,lisp_frame.savevsp(sp)))
1444        __(discard_lisp_frame())
1445        /* can use nfn (= temp2) as a temporary */
1446        __(subi imm1,nargs,nargregs<<fixnumshift)
1447        __(add imm1,imm1,vsp)
1448        __(mtlr loc_pc)
14491:
1450        __(lwzu temp2,-4(imm1))
1451        __(cmpr(cr0,imm1,vsp))
1452        __(push(temp2,imm0))
1453        __(bne cr0,1b)
1454        __(mr vsp,imm0)
1455        __(do_funcall())
1456
1457        /* No args were vpushed; recover saved context & do funcall */
1458_spentry(tfuncallvsp)
1459        __(ldr(loc_pc,lisp_frame.savelr(sp)))
1460        __(ldr(fn,lisp_frame.savefn(sp)))
1461        __(ldr(vsp,lisp_frame.savevsp(sp)))
1462        __(mtlr loc_pc)
1463        __(discard_lisp_frame())
1464        __(do_funcall())
1465       
1466/* Tail-recursively call the (known symbol) in fname. */
1467/* In the general case, we don't know if any args were */
1468/* vpushed or not.  If so, we have to "slide" them down */
1469/* to the base of the frame.  If not, we can just restore */
1470/* vsp, lr, fn from the saved lisp frame on the control stack. */
1471_spentry(tcallsymgen)
1472        __(cmpri(cr0,nargs,nargregs<<fixnumshift))
1473        __(ldr(loc_pc,lisp_frame.savelr(sp)))
1474        __(ldr(fn,lisp_frame.savefn(sp)))
1475        __(mtlr loc_pc)
1476        __(ble cr0,2f)
1477
1478        __(ldr(imm0,lisp_frame.savevsp(sp)))
1479        __(discard_lisp_frame())
1480        /* can use nfn (= temp2) as a temporary */
1481        __(subi imm1,nargs,nargregs<<fixnumshift)
1482        __(add imm1,imm1,vsp)
14831:
1484        __(lwzu temp2,-4(imm1))
1485        __(cmpr(cr0,imm1,vsp))
1486        __(push(temp2,imm0))
1487        __(bne cr0,1b)
1488        __(mr vsp,imm0)
1489        __(jump_fname)
1490       
14912:             
1492        __(ldr(vsp,lisp_frame.savevsp(sp)))
1493        __(discard_lisp_frame())
1494        __(jump_fname)
1495       
1496       
1497/* Some args were vpushed.  Slide them down to the base of */
1498/* the current frame, then do funcall. */
1499_spentry(tcallsymslide)
1500        __(ldr(loc_pc,lisp_frame.savelr(sp)))
1501        __(ldr(fn,lisp_frame.savefn(sp)))
1502        __(ldr(imm0,lisp_frame.savevsp(sp)))
1503        __(discard_lisp_frame())
1504        __(mtlr loc_pc)
1505        /* can use nfn (= temp2) as a temporary */
1506        __(subi imm1,nargs,nargregs<<fixnumshift)
1507        __(add imm1,imm1,vsp)
15081:
1509        __(lwzu temp2,-4(imm1))
1510        __(cmpr(cr0,imm1,vsp))
1511        __(push(temp2,imm0))
1512        __(bne cr0,1b)
1513        __(mr vsp,imm0)
1514        __(jump_fname)
1515
1516/* No args were vpushed; recover saved context & call symbol */
1517_spentry(tcallsymvsp)
1518        __(ldr(loc_pc,lisp_frame.savelr(sp)))
1519        __(ldr(fn,lisp_frame.savefn(sp)))
1520        __(ldr(vsp,lisp_frame.savevsp(sp)))
1521        __(discard_lisp_frame())
1522        __(mtlr loc_pc)
1523        __(jump_fname)
1524       
1525/* Tail-recursively call the function in nfn. */
1526        /* Pretty much the same as the tcallsym* cases above. */
1527_spentry(tcallnfngen)
1528        __(cmpri(cr0,nargs,nargregs<<fixnumshift))
1529        __(ble cr0,_SPtcallnfnvsp)
1530        __(b _SPtcallnfnslide)
1531
1532/* Some args were vpushed.  Slide them down to the base of */
1533/* the current frame, then do funcall. */
1534_spentry(tcallnfnslide)
1535        __(ldr(loc_pc,lisp_frame.savelr(sp)))
1536        __(ldr(fn,lisp_frame.savefn(sp)))
1537        __(ldr(imm0,lisp_frame.savevsp(sp)))
1538        __(discard_lisp_frame())
1539        __(mtlr loc_pc)
1540        /* Since we have a known function, can use fname as a temporary. */
1541        __(subi imm1,nargs,nargregs<<fixnumshift)
1542        __(add imm1,imm1,vsp)
15431:
1544        __(lwzu fname,-4(imm1))
1545        __(cmpr(cr0,imm1,vsp))
1546        __(push(fname,imm0))
1547        __(bne cr0,1b)
1548        __(mr vsp,imm0)
1549        __(jump_nfn())
1550       
1551_spentry(tcallnfnvsp)
1552        __(ldr(loc_pc,lisp_frame.savelr(sp)))
1553        __(ldr(fn,lisp_frame.savefn(sp)))
1554        __(ldr(vsp,lisp_frame.savevsp(sp)))
1555        __(discard_lisp_frame())
1556        __(mtlr loc_pc)
1557        __(jump_nfn())
1558       
1559_spentry(misc_ref)
1560        __(trap_unless_fulltag_equal(arg_y,fulltag_misc,imm0))
1561        __(trap_unless_lisptag_equal(arg_z,tag_fixnum,imm0))
1562        __(vector_length(imm0,arg_y,imm1))
1563        __(trlge(arg_z,imm0))
1564        __(extract_lowbyte(imm1,imm1))  /* imm1 = subtag */
1565       
1566/* Reference index arg_z of a misc-tagged object (arg_y).
1567   Note that this conses in some cases.  Return a properly-tagged
1568   lisp object in arg_z.  Do type and bounds-checking.
1569*/
1570       
1571misc_ref_common:
1572        __(extract_fulltag(imm2,imm1))
1573        __(cmpri(cr0,imm2,fulltag_nodeheader))
1574        __(cmpri(cr1,imm1,max_32_bit_ivector_subtag))
1575        __(cmpri(cr2,imm1,max_8_bit_ivector_subtag))
1576        __(addi imm0,arg_z,misc_data_offset)
1577        __(bne cr0,local_label(ref_imm))
1578        /* A node vector. */
1579        __(ldrx(arg_z,arg_y,imm0))
1580        __(blr)
1581local_label(ref_imm):
1582        __(bgt cr1,local_label(ref_not32))
1583        __(cmpri(cr1,imm1,subtag_single_float_vector))
1584        __(cmpri(cr0,imm1,subtag_s32_vector))
1585        __(ldrx(imm0,arg_y,imm0))
1586        __(beq cr1,local_label(ref_sfloat))
1587        __(beq cr0,local_label(ref_signed))
1588local_label(ref_unsigned):
1589        __(cmpri(cr1,imm0,0))
1590        __(srawi. imm1,imm0,31-nfixnumtagbits)
1591        __(box_fixnum(arg_z,imm0))
1592        __(beqlr+ cr0)
1593        __(li imm1,one_digit_bignum_header)
1594        __(blt cr1,local_label(two_digit))
1595        __(Misc_Alloc_Fixed(arg_z,imm1,8))
1596        __(str(imm0,misc_data_offset(arg_z)))
1597        __(blr)
1598local_label(two_digit):
1599        __(li imm1,two_digit_bignum_header)
1600        __(Misc_Alloc_Fixed(arg_z,imm1,16))
1601        __(str(imm0,misc_data_offset(arg_z)))
1602        __(blr)
1603local_label(ref_signed):
1604        __(addo imm1,imm0,imm0)
1605        __(addo. arg_z,imm1,imm1)
1606        __(bnslr)
1607        __(mtxer rzero)
1608        __(li imm1,one_digit_bignum_header)
1609        __(Misc_Alloc_Fixed(arg_z,imm1,8))
1610        __(str(imm0,misc_data_offset(arg_z)))
1611        __(blr)
1612local_label(ref_sfloat):
1613        __(li imm1,single_float_header)
1614        __(Misc_Alloc_Fixed(arg_z,imm1,single_float.size))
1615        __(str(imm0,single_float.value(arg_z)))
1616        __(blr)
1617local_label(ref_not32):
1618        __(cmpri(cr1,imm1,max_16_bit_ivector_subtag))
1619        __(bgt cr2,local_label(ref_not8))
1620        /* 8-bit objects are either u8, s8, or base_strings. */
1621        /* cr2_eq is set if base_string (= max_8_bit_ivector_subtag) */
1622        __(cmpri(cr1,imm1,subtag_s8_vector))
1623        __(srwi imm0,arg_z,2)
1624        __(la imm0,misc_data_offset(imm0))
1625        __(lbzx imm0,arg_y,imm0)
1626        __(beq cr2,local_label(ref_char))
1627        __(bne cr1,local_label(ref_box))
1628        __(extsb imm0,imm0)
1629local_label(ref_box):   
1630        __(box_fixnum(arg_z,imm0))
1631        __(blr)
1632local_label(ref_char): 
1633        __(slwi arg_z,imm0,charcode_shift)
1634        __(ori arg_z,arg_z,subtag_character)
1635        __(blr)
1636local_label(ref_not8):
1637        __(cmpri(cr2,imm1,subtag_bit_vector))
1638        __(bgt cr1,local_label(ref_not16))
1639        /* 16-bit objects are either u16, s16, or general_strings. */
1640        /* cr1_eq is set if s16_vector (= max_16_bit_ivector_subtag) */
1641        __(cmpri(cr0,imm1,subtag_simple_general_string))
1642        __(srwi imm0,arg_z,1)
1643        __(la imm0,misc_data_offset(imm0))
1644        __(lhzx imm0,arg_y,imm0)
1645        __(beq cr0,local_label(ref_char))
1646        __(bne cr1,local_label(ref_box))
1647        __(extsh imm0,imm0)
1648        __(b local_label(ref_box))
1649local_label(ref_not16):
1650        __(bne cr2,local_label(ref_dfloat))
1651        __(extrwi imm1,arg_z,5,32-(fixnumshift+5))      /* imm1 = bitnum */
1652        __(la imm1,1+fixnumshift(imm1))
1653        __(rlwinm imm0,arg_z,32-5,5,31-fixnumshift)
1654        __(la imm0,misc_data_offset(imm0))
1655        __(ldrx(imm0,arg_y,imm0))
1656        __(rlwnm arg_z,imm0,imm1,31-fixnumshift,31-fixnumshift)
1657        __(blr)
1658local_label(ref_dfloat):
1659        __(slwi imm0,arg_z,1)
1660        __(la imm0,misc_dfloat_offset(imm0))
1661        __(la imm1,4(imm0))
1662        __(ldrx(imm0,arg_y,imm0))
1663        __(ldrx(imm1,arg_y,imm1))
1664        __(li imm2,double_float_header)
1665        __(Misc_Alloc_Fixed(arg_z,imm2,double_float.size))
1666        __(str(imm0,double_float.value(arg_z)))
1667        __(str(imm1,double_float.value+4(arg_z)))
1668        __(blr)
1669       
1670       
1671/* misc_set (vector index newval).  Pretty damned similar to
1672   misc_ref, as one might imagine.
1673*/
1674_spentry(misc_set)
1675        __(trap_unless_fulltag_equal(arg_x,fulltag_misc,imm0))
1676        __(trap_unless_lisptag_equal(arg_y,tag_fixnum,imm0))
1677        __(vector_length(imm0,arg_x,imm1))
1678        __(trlge(arg_y,imm0))
1679        __(extract_lowbyte(imm1,imm1))
1680        __(b misc_set_common)
1681       
1682/* Make a cons cell on the vstack.  Always push 3 words, 'cause we're 
1683   not sure how the vstack will be aligned. */
1684_spentry(stkconsyz)
1685        __(li imm0,nil_value)
1686        __(vpush(imm0))
1687        __(vpush(imm0))
1688        __(vpush(imm0))
1689        __(andi. imm0,vsp,1<<2) /* (oddp vsp ?) */
1690        __(beq cr0,1f)
1691        __(str(arg_y,8(vsp))) /* car */
1692        __(str(arg_z,4(vsp))) /* cdr */
1693        __(la arg_z,fulltag_cons+4(vsp))
1694        __(blr)
16951:
1696        __(str(arg_y,4(vsp))) /* car, again */
1697        __(str(arg_z,0(vsp)))
1698        __(la arg_z,fulltag_cons(vsp))
1699        __(blr)
1700
1701/* Make a stack-consed value cell.  Much like the case of
1702   stack-allocating a cons cell.  Imm0 points to the closed-over value
1703   (already vpushed).  Replace that locative with the vcell. */
1704_spentry(stkvcell0)
1705        __(sub imm1,imm0,vsp) /* imm1 = delta from vsp to value cell loc */
1706        __(li arg_z,nil_value)
1707        __(vpush(arg_z))
1708        __(vpush(arg_z))
1709        __(vpush(arg_z))
1710        __(addi imm1,imm1,12)
1711        __(add imm0,vsp,imm1) /* in case stack overflowed */
1712        __(andi. imm1,vsp,1<<2) /* (oddp vsp) ? */
1713        __(li imm1,value_cell_header)
1714        __(ldr(arg_z,0(imm0)))
1715        __(beq cr0,1f)
1716        __(str(arg_z,8(vsp)))
1717        __(str(imm1,4(vsp)))
1718        __(la arg_z,fulltag_misc+4(vsp))
1719        __(str(arg_z,0(imm0)))
1720        __(blr)
17211:
1722        __(str(arg_z,4(vsp)))
1723        __(str(imm1,0(vsp)))
1724        __(la arg_z,fulltag_misc(vsp))
1725        __(str(arg_z,0(imm0)))
1726        __(blr)
1727
1728       
1729_spentry(stkvcellvsp)     
1730        __(li arg_z,nil_value)
1731        __(vpush(arg_z))
1732        __(vpush(arg_z))
1733        __(vpush(arg_z))
1734        __(li imm1,12)
1735        __(add imm0,vsp,imm1) /* in case stack overflowed */
1736        __(andi. imm1,vsp,1<<2) /* (oddp vsp) ? */
1737        __(li imm1,value_cell_header)
1738        __(ldr(arg_z,0(imm0)))
1739        __(beq cr0,1f)
1740        __(str(arg_z,8(vsp)))
1741        __(str(imm1,4(vsp)))
1742        __(la arg_z,fulltag_misc+4(vsp))
1743        __(str(arg_z,0(imm0)))
1744        __(blr)
17451:
1746        __(str(arg_z,4(vsp)))
1747        __(str(imm1,0(vsp)))
1748        __(la arg_z,fulltag_misc(vsp))
1749        __(str(arg_z,0(imm0)))
1750        __(blr)
1751
1752/* Make a "raw" area on the temp stack, stack-cons a macptr to point to it,
1753   and return the macptr.  Size (in bytes, boxed) is in arg_z on entry; macptr in
1754   arg_z on exit.
1755   It would be nice to cons in the Mac heap if there's not room on
1756   the tstack. This code will handle a new tstack segment being added. */
1757_spentry(makestackblock)
1758        __(unbox_fixnum(imm0,arg_z))
1759        __(dnode_align(imm0,imm0,tsp_frame.fixed_overhead+macptr.size))
1760        __(cmplri(cr0,imm0,tstack_alloc_limit))
1761        __(bge cr0,1f)
1762        __(TSP_Alloc_Var_Unboxed(imm0))
1763        __(li imm0,macptr_header)
1764        __(la imm1,tsp_frame.data_offset+macptr.size(tsp))
1765        __(str(imm0,tsp_frame.data_offset(tsp)))
1766        __(la arg_z,tsp_frame.data_offset+fulltag_misc(tsp))
1767        __(str(imm1,macptr.address(arg_z)))
1768        __(stfd fp_zero,macptr.domain(arg_z))
1769        __(blr)
1770
1771/* Too big. Heap cons a gcable macptr */
17721:
1773        __(TSP_Alloc_Fixed_Unboxed(0))
1774        __(set_nargs(1))
1775        __(li fname,nrs.new_gcable_ptr)
1776        __(jump_fname())
1777
1778/* As above, only set the block's contents to 0. */
1779_spentry(makestackblock0)
1780        __(unbox_fixnum(imm0,arg_z))
1781        __(dnode_align(imm0,imm0,tsp_frame.fixed_overhead+macptr.size))
1782        __(cmplri(cr0,imm0,tstack_alloc_limit))
1783        __(bge cr0,3f)
1784        __(TSP_Alloc_Var_Unboxed(imm0))
1785        __(Zero_TSP_Frame(imm0,imm1))
1786        __(li imm0,macptr_header)
1787        __(la imm1,tsp_frame.data_offset+macptr.size(tsp))
1788        __(str(imm0,tsp_frame.data_offset(tsp)))
1789        __(la arg_z,tsp_frame.data_offset+fulltag_misc(tsp))
1790        __(str(imm1,macptr.address(arg_z))) /* makestackblock0 expects the address to be in imm1 */
1791        __(stfd fp_zero,macptr.domain(arg_z))
1792        __(blr)
1793
1794/* Too big. Heap cons a gcable macptr */
17953:
1796        __(TSP_Alloc_Fixed_Unboxed(0)) /* "raw" block to make the compiler happy */
1797
1798        __(mr arg_y,arg_z) /* save block size */
1799        __(li arg_z,t_value) /* clear-p arg to %new-gcable-ptr */
1800        __(set_nargs(2))
1801        __(li fname,nrs.new_gcable_ptr)
1802        __(jump_fname())
1803
1804/* Make a list of length arg_y (boxed), initial-element arg_z (boxed) on
1805   the tstack.  Return the list in arg_z. */
1806_spentry(makestacklist)
1807        __(add imm0,arg_y,arg_y)
1808        __(cmplri(cr1,imm0,((tstack_alloc_limit+1)-8)))
1809        __(addi imm0,imm0,tsp_frame.fixed_overhead)
1810        __(bge cr1,3f)
1811        __(TSP_Alloc_Var_Boxed(imm0,imm1))
1812        __(mr imm1,arg_y)
1813        __(cmpri(cr1,imm1,0))
1814        __(mr arg_y,arg_z)
1815        __(li arg_z,nil_value)
1816        __(ldr(imm2,tsp_frame.backlink(tsp)))
1817        __(la imm2,-8+tag_list(imm2))
1818        __(b 2f)
18191:
1820        __(subi imm1,imm1,fixnum1)
1821        __(cmpri(cr1,imm1,0))
1822        __(rplacd(imm2,arg_z))
1823        __(rplaca(imm2,arg_y))
1824        __(mr arg_z,imm2)
1825        __(subi imm2,imm2,cons.size)
18262:
1827        __(bne cr1,1b)
1828        __(blr)
1829
18303:
1831        __(cmpri(cr1,arg_y,0))
1832        __(TSP_Alloc_Fixed_Boxed(0))  /* make the compiler happy */
1833        __(mr imm1,arg_y) /* count */
1834        __(mr arg_y,arg_z) /* initial value */
1835        __(li arg_z,nil_value) /* result */
1836        __(b 5f)
18374:
1838        __(subi imm1,imm1,fixnum1)
1839        __(cmpri(cr1,imm1,0))
1840        __(Cons(arg_z,arg_y,arg_z))
18415:
1842        __(bne cr1,4b)
1843        __(blr)
1844
1845/* subtype (boxed) vpushed before initial values. (Had better be a
1846        node header subtag.) Nargs set to count of things vpushed. */
1847
1848_spentry(stkgvector)
1849        __(la imm0,-4(nargs))
1850        __(cmpri(cr1,imm0,0))
1851        __(add imm1,vsp,nargs)
1852        __(lwzu temp0,-4(imm1))
1853        __(slwi imm2,imm0,num_subtag_bits-fixnumshift)
1854        __(rlwimi imm2,temp0,32-fixnumshift,32-num_subtag_bits,31)
1855        __(dnode_align(imm0,imm0,node_size+tsp_frame.fixed_overhead))
1856        __(TSP_Alloc_Var_Boxed_nz(imm0,imm3))
1857        __(str(imm2,tsp_frame.data_offset(tsp)))
1858        __(la arg_z,tsp_frame.data_offset+fulltag_misc(tsp))
1859        __(la imm3,misc_header_offset(arg_z))
1860        __(li imm0,fixnum1)
1861        __(b 2f)
18621:
1863        __(addi imm0,imm0,fixnum1)
1864        __(cmpr(cr1,imm0,nargs))
1865        __(lwzu temp0,-4(imm1))
1866        __(stwu temp0,4(imm3))
18672:
1868        __(bne cr1,1b)
1869        __(add vsp,vsp,nargs)
1870        __(blr)
1871
1872/* Allocate a "fulltag_misc" object.  On entry, arg_y contains the element */
1873/* count (boxed) and  arg_z contains the subtag (boxed).  Both of these  */
1874/* parameters must be "reasonable" (the  subtag must be valid, the element */
1875/* count must be of type (unsigned-byte 24).  */
1876/* On exit, arg_z contains the (properly tagged) misc object; it'll have a */
1877/* proper header on it and its contents will be 0.   imm0 contains  */
1878/* the object's header (fulltag = fulltag_immheader or fulltag_nodeheader.) */
1879/* This is intended for things like "make-array" and "%make-bignum" and the  */
1880/* like.  Things that involve creating small objects of known size can usually */
1881/* do so inline with less hair. */
1882
1883/* If this has to go out-of-line (to GC or whatever), it should do so via a  */
1884/* trap (or should otherwise ensure that both the LR and CTR are preserved  */
1885/* where the GC can find them.) */
1886
1887
1888_spentry(misc_alloc)
1889        __(extract_unsigned_byte_bits_(imm2,arg_y,24))
1890        __(unbox_fixnum(imm0,arg_z))
1891        __(extract_fulltag(imm1,imm0))
1892        __(bne- cr0,9f)
1893        __(cmpri(cr0,imm1,fulltag_nodeheader))
1894        __(mr imm3,imm0)
1895        __(cmplri(cr1,imm0,max_32_bit_ivector_subtag))
1896        __(rlwimi imm0,arg_y,num_subtag_bits-fixnum_shift,0,31-num_subtag_bits  /* imm0 now = header */)
1897        __(mr imm2,arg_y)
1898        __(beq cr0,1f)  /* do probe if node object (fixnum element count = byte count). */
1899        __(cmplri(cr0,imm3,max_16_bit_ivector_subtag))
1900        __(bng cr1,1f)  /* do probe if 32-bit imm object */
1901        __(cmplri(cr1,imm3,max_8_bit_ivector_subtag))
1902        __(srwi imm2,imm2,1)
1903        __(bgt cr0,2f)
1904        __(bgt cr1,1f)
1905        __(srwi imm2,imm2,1)
1906/* imm2 now = byte count.  Add 4 for header, 7 to align, then clear low three bits. */
19071:
1908        __(dnode_align(imm2,imm2,node_size))
1909
1910        __(Misc_Alloc(arg_z,imm0,imm2))
1911        __(blr)
19122:
1913        __(cmplri(imm3,subtag_double_float_vector))
1914        __(slwi imm2,arg_y,1)
1915        __(beq 1b)
1916        __(addi imm2,arg_y,7<<fixnumshift)
1917        __(srwi imm2,imm2,fixnumshift+3)
1918        __(b 1b)
19199:
1920        __(uuo_interr(error_object_not_unsigned_byte_24,arg_y))
1921       
1922/* almost exactly as above, but "swap exception handling info"
1923   on exit and return */
1924_spentry(ffcallX)
1925        __(mflr loc_pc)
1926        __(vpush_saveregs())            /* Now we can use save0-save7 to point to stacks */
1927        __(mr save0,rcontext)   /* or address globals. */
1928        __(extract_typecode(imm0,arg_z))
1929        __(cmpri(cr7,imm0,subtag_macptr))
1930        __(ldr(save1,c_frame.backlink(sp)))     /* bottom of reserved lisp frame */
1931        __(la save2,-lisp_frame.size(save1))    /* top of lisp frame*/
1932        __(zero_doublewords save2,0,lisp_frame.size)
1933        __(str(save1,lisp_frame.backlink(save2)))
1934        __(str(save2,c_frame.backlink(sp)))
1935        __(str(fn,lisp_frame.savefn(save2)))
1936        __(str(loc_pc,lisp_frame.savelr(save2)))
1937        __(str(vsp,lisp_frame.savevsp(save2)))
1938        __(bne cr7,1f)
1939        __(ldr(arg_z,macptr.address(arg_z)))
19401:
1941        __(ldr(save3,tcr.cs_area(rcontext)))
1942        __(str(save2,area.active(save3)))
1943        __(str(allocptr,tcr.save_allocptr(rcontext)))
1944        __(str(allocbase,tcr.save_allocbase(rcontext)))
1945        __(str(tsp,tcr.save_tsp(rcontext)))
1946        __(str(vsp,tcr.save_vsp(rcontext)))
1947        __(str(rzero,tcr.ffi_exception(rcontext)))
1948        __(mffs f0)
1949        __(stfd f0,tcr.lisp_fpscr(rcontext))    /* remember lisp's fpscr */
1950        __(mtfsf 0xff,fp_zero)  /* zero foreign fpscr */
1951        __(ldr(r3,tcr.foreign_exception_status(rcontext)))
1952        __(cmpri(r3,0))
1953        __(ref_global(r12,lisp_exit_hook))
1954        __(mtctr r12)
1955        __(beq+ 1f)
1956        __(stru(sp,-(stack_align(c_frame.minsiz))(sp)))
1957        __(bctrl)
1958        __(la sp,(stack_align(c_frame.minsiz))(sp))
19591:     
1960        __(li rcontext,0)
1961        __(mtctr arg_z)
1962        __(ldr(r3,c_frame.param0(sp)))
1963        __(ldr(r4,c_frame.param1(sp)))
1964        __(ldr(r5,c_frame.param2(sp)))
1965        __(ldr(r6,c_frame.param3(sp)))
1966        __(ldr(r7,c_frame.param4(sp)))
1967        __(ldr(r8,c_frame.param5(sp)))
1968        __(ldr(r9,c_frame.param6(sp)))
1969        __(ldr(r10,c_frame.param7(sp)))
1970        /* Darwin is allegedly very picky about what register points
1971           to the function on entry. */
1972        __(mr r12,arg_z)
1973        __(bctrl)
1974        __(ref_global(r12,lisp_return_hook))
1975        __(mtctr r12)
1976        __(str(r3,c_frame.param0(sp)))
1977        __(str(r4,c_frame.param1(sp)))
1978        __(stfd f1,c_frame.param2(sp))
1979        __(stru(sp,-(stack_align(c_frame.minsiz))(sp)))
1980        __(mr r3,save0)
1981        __(bctrl)
1982        __(la sp,(stack_align(c_frame.minsiz))(sp))
1983        __(ldr(r3,c_frame.param0(sp)))
1984        __(ldr(r4,c_frame.param1(sp)))
1985        __(lfd f1,c_frame.param2(sp))
1986        __(b _local_label(FF_call_return_common))       
1987       
1988/* Bind special symbol in arg_z to its current value. */
1989_spentry(bind_self_boundp_check)
1990        __(ldr(imm0,symbol.flags(arg_z)))
1991        __(andi. imm0,imm0,sym_vbit_bound_mask)
1992        __(mr arg_y,arg_z)
1993        __(ldr(imm2,tcr.db_link(rcontext)))
1994        __(cmpri(cr1,imm2,0))
1995        __(beq 8f)
1996        __(b 1f)
19970:      __(mr imm1,imm2)
1998        __(ldr(temp0,4(imm1)))
1999        __(cmpr(temp0,arg_y))
2000        __(ldr(imm2,0(imm1)))
2001        __(cmpri(cr1,imm2,0))
2002        __(bne 1f)
2003        __(ldr(arg_z,8(imm1)))
2004        __(b 9f)
20051:      __(bne cr1,0b)
20068:      __(ldr(arg_z,symbol.vcell(arg_y)))
20079:      __(treqi(arg_z,unbound_marker))
2008        __(ldr(imm0,symbol.flags(arg_y)))
2009        __(ori imm0,imm0,sym_vbit_bound_mask)
2010        __(ldr(imm1,tcr.db_link(rcontext)))
2011        __(vpush(arg_z))
2012        __(vpush(arg_y))
2013        __(vpush(imm1))
2014        __(str(vsp,tcr.db_link(rcontext)))
2015        __(str(imm0,symbol.flags(arg_y)))
2016        __(blr)
2017
2018/* Destructuring-bind, macro-bind.
2019   */
2020/* OK to use arg_x, arg_y for whatever (tagged) purpose; 
2021   likewise immX regs.
2022   arg_z preserved, nothing else in particular defined on exit.
2023   nargs contains req count (0-255) in PPC bits mask_req_start/mask_req_width, 
2024                  opt count (0-255) in PPC bits mask_opt_start/mask_opt_width, 
2025                  key count (0-255) in PPC bits mask_key_start/mask_key_width, 
2026                  opt-supplied-p flag in PPC bit mask_initopt, 
2027                  keyp flag in PPC bit mask_keyp, 
2028                  &allow-other-keys flag in PPC bit mask_aok, 
2029                   &rest flag in PPC bit mask_restp.
2030   When mask_keyp bit is set, keyvect contains vector of keyword symbols, 
2031        length key count. */
2032
2033_spentry(macro_bind)
2034        __(mr whole_reg,arg_reg)
2035        __(extract_lisptag(imm0,arg_reg))
2036        __(cmpri(cr0,imm0,tag_list))
2037        __(bne- cr0,1f)
2038        __(_cdr(arg_reg,arg_reg))
2039        __(b destbind1)
20401:
2041        __(li arg_y,XCALLNOMATCH)
2042        __(mr arg_z,whole_reg)
2043        __(set_nargs(2))
2044        __(b _SPksignalerr)
2045
2046
2047_spentry(destructuring_bind)
2048        __(mr whole_reg,arg_reg)
2049        __(b destbind1)
2050       
2051_spentry(destructuring_bind_inner)
2052        __(mr whole_reg,arg_z)
2053destbind1:     
2054        /* Extract required arg count. */
2055         /* A bug in gas: can't handle shift count of "32" (= 0 */
2056        ifelse(eval(mask_req_width+mask_req_start),eval(32),[
2057        __(clrlwi. imm0,nargs,mask_req_start)
2058        ],[
2059        __(extrwi. imm0,nargs,mask_req_width,mask_req_start)
2060        ])
2061        __(extrwi imm1,nargs,mask_opt_width,mask_opt_start)
2062        __(rlwinm imm2,nargs,0,mask_initopt,mask_initopt)
2063        __(rlwinm imm4,nargs,0,mask_keyp,mask_keyp)
2064        __(cmpri(cr4,imm4,0))
2065        __(rlwinm imm4,nargs,0,mask_restp,mask_restp)
2066        __(cmpri(cr5,imm4,0))
2067        __(cmpri(cr1,imm1,0))
2068        __(cmpri(cr2,imm2,0))
2069        /* Save entry vsp in case of error. */
2070        __(mr imm4,vsp)
2071        __(beq cr0,2f)
20721:
2073        __(cmpri(cr7,arg_reg,nil_value))
2074        __(extract_lisptag(imm3,arg_reg))
2075        __(cmpri(cr3,imm3,tag_list))
2076        __(subi imm0,imm0,1)
2077        __(cmpri(cr0,imm0,0))
2078        __(beq cr7,toofew)
2079        __(bne cr3,badlist)
2080        __(ldr(arg_x,cons.car(arg_reg)))
2081        __(ldr(arg_reg,cons.cdr(arg_reg)))
2082        __(vpush(arg_x))
2083        __(bne cr0,1b)
20842:
2085        __(beq cr1,rest_keys)
2086        __(bne cr2,opt_supp)
2087        /* 'simple' &optionals:  no supplied-p, default to nil. */
2088simple_opt_loop:
2089        __(cmpri(cr0,arg_reg,nil_value))
2090        __(extract_lisptag(imm3,arg_reg))
2091        __(cmpri(cr3,imm3,tag_list))
2092        __(subi imm1,imm1,1)
2093        __(cmpri(cr1,imm1,0))
2094        __(li imm5,nil_value)
2095        __(beq cr0,default_simple_opt)
2096        __(bne cr3,badlist)
2097        __(ldr(arg_x,cons.car(arg_reg)))
2098        __(ldr(arg_reg,cons.cdr(arg_reg)))
2099        __(vpush(arg_x))
2100        __(bne cr1,simple_opt_loop)
2101        __(b rest_keys)
2102default_simple_opt_loop:
2103        __(subi imm1,imm1,1)
2104        __(cmpri(cr1,imm1,0))
2105default_simple_opt:
2106        __(vpush(imm5))
2107        __(bne cr1,default_simple_opt_loop)
2108        __(b rest_keys)
2109        /* Provide supplied-p vars for the &optionals. */
2110opt_supp:
2111        __(li arg_y,t_value)
2112opt_supp_loop:
2113        __(cmpri(cr0,arg_reg,nil_value))
2114        __(extract_lisptag(imm3,arg_reg))
2115        __(cmpri(cr3,imm3,tag_list))
2116        __(subi imm1,imm1,1)
2117        __(cmpri(cr1,imm1,0))
2118        __(beq cr0,default_hard_opt)
2119        __(bne cr3,badlist)
2120        __(ldr(arg_x,cons.car(arg_reg)))
2121        __(ldr(arg_reg,cons.cdr(arg_reg)))
2122        __(vpush(arg_x))
2123        __(vpush(arg_y))
2124        __(bne cr1,opt_supp_loop)
2125        __(b rest_keys)
2126default_hard_opt_loop:
2127        __(subi imm1,imm1,1)
2128        __(cmpri(cr1,imm1,0))
2129default_hard_opt:
2130        __(vpush(imm5))
2131        __(vpush(imm5))
2132        __(bne cr1,default_hard_opt_loop)
2133rest_keys:
2134        __(cmpri(cr0,arg_reg,nil_value))
2135        __(bne cr5,have_rest)
2136        __(bne cr4,have_keys)
2137        __(bne cr0,toomany)
2138        __(blr)
2139have_rest:
2140        __(vpush(arg_reg))
2141        __(beqlr cr4)
2142have_keys:
2143        /* Ensure that arg_reg contains a proper,even-length list. */
2144        /* Insist that its length is <= 512 (as a cheap circularity check.) */
2145        __(li imm0,256)
2146        __(mr arg_x,arg_reg)
2147count_keys_loop:
2148        __(extract_lisptag(imm3,arg_x))
2149        __(cmpri(cr3,imm3,tag_list))
2150        __(cmpri(cr0,arg_x,nil_value))
2151        __(subi imm0,imm0,1)
2152        __(cmpri(cr4,imm0,0))
2153        __(bne cr3,badlist)
2154        __(beq cr0,counted_keys)
2155        __(ldr(arg_x,cons.cdr(arg_x)))
2156        __(extract_lisptag(imm3,arg_x))
2157        __(cmpri(cr3,imm3,tag_list))
2158        __(blt cr4,toomany)
2159        __(cmpri(cr0,arg_x,nil_value))
2160        __(bne cr3,badlist)
2161        __(beq cr0,db_badkeys)
2162        __(ldr(arg_x,cons.cdr(arg_x)))
2163        __(b count_keys_loop)
2164counted_keys:
2165        /*
2166          We've got a proper, even-length list of key/value pairs in
2167        arg_reg. For each keyword var in the lambda-list, push a pair
2168        of NILs on the vstack. */
2169        __(extrwi. imm0,nargs,mask_key_width,mask_key_start )
2170        __(mr imm2,imm0)        /* save number of keys */
2171        __(li imm5,nil_value)
2172        __(b push_pair_test)
2173push_pair_loop:
2174        __(cmpri(cr0,imm0,1))
2175        __(subi imm0,imm0,1)
2176        __(vpush(imm5))
2177        __(vpush(imm5))
2178push_pair_test:
2179        __(bne cr0,push_pair_loop)
2180        __(slwi imm2,imm2,3)            /* pairs -> bytes */
2181        __(add imm2,vsp,imm2)           /* imm2 points below pairs */
2182        __(li imm0,0)                   /* count unknown keywords so far */
2183        __(extrwi imm1,nargs,1,mask_aok) /* unknown keywords allowed */
2184        __(extrwi nargs,nargs,mask_key_width,mask_key_start)
2185        /* Now, for each keyword/value pair in the list */
2186        /*  a) if the keyword is found in the keyword vector, set the */
2187        /*     corresponding entry on the vstack to the value and the */
2188        /*     associated supplied-p var to T. */
2189        /*  b) Regardless of whether or not the keyword is found, */
2190        /*     if the keyword is :ALLOW-OTHER-KEYS and the value is non-nil, */
2191        /*     set imm1 to a non-zero value to indicate that unknown keywords */
2192        /*     are acceptable. */
2193        /*  c) If the keyword is not found (and isn't :ALLOW-OTHER-KEYS), increment */
2194        /*     the count of unknown keywords in imm0. */
2195        /* At the end of the list, signal an error if any unknown keywords were seen */
2196        /* but not allowed.  Otherwise, return. */
2197
2198match_keys_loop:
2199        __(cmpri(cr0,arg_reg,nil_value))
2200        __(li imm0,0)
2201        __(li imm3,misc_data_offset)
2202        __(beq cr0,matched_keys)
2203        __(ldr(arg_x,cons.car(arg_reg)))
2204        __(li arg_y,nrs.kallowotherkeys)
2205        __(cmpr(cr3,arg_x,arg_y))       /* :ALLOW-OTHER-KEYS ? */
2206        __(ldr(arg_reg,cons.cdr(arg_reg)))
2207        __(ldr(arg_y,cons.car(arg_reg)))
2208        __(cmpri(cr0,arg_y,nil_value))
2209        __(cmpr(cr4,imm0,nargs))
2210        __(ldr(arg_reg,cons.cdr(arg_reg)))
2211        __(bne cr3,match_test)
2212        __(beq cr0,match_test)
2213        __(ori imm1,imm1,1)
2214        __(b match_test)
2215match_loop:
2216        __(ldrx(temp0,keyvect_reg,imm3))
2217        __(cmpr(cr0,arg_x,temp0))
2218        __(addi imm0,imm0,1)
2219        __(cmpr(cr4,imm0,nargs))
2220        __(addi imm3,imm3,4)
2221        __(bne cr0,match_test)
2222        /* Got a hit.  Unless this keyword's been seen already, set it. */
2223        __(slwi imm0,imm0,3)
2224        __(subf imm0,imm0,imm2)
2225        __(ldr(temp0,0(imm0)))
2226        __(cmpri(cr0,temp0,nil_value))
2227        __(li temp0,t_value)
2228        __(bne cr0,match_keys_loop)     /* already saw this */
2229        __(str(arg_y,4(imm0)))
2230        __(str(temp0,0(imm0)))
2231        __(b match_keys_loop)
2232match_test:
2233        __(bne cr4,match_loop)
2234        __(oris imm1,imm1,0x8000)
2235        __(b match_keys_loop)
2236matched_keys:
2237        __(cmpri(cr1,imm1,0))
2238        __(add imm1,imm1,imm1)
2239        __(cmpri(cr0,imm1,0))
2240        __(bgelr cr1)
2241        __(bnelr cr0)
2242        /* Some unrecognized keywords.  Complain generically about */
2243        /* invalid keywords. */
2244db_badkeys:
2245        __(li arg_y,XBADKEYS)
2246        __(b destructure_error)
2247toomany:
2248        __(li arg_y,XCALLTOOMANY)
2249        __(b destructure_error)
2250toofew:
2251        __(li arg_y,XCALLTOOFEW)
2252        __(b destructure_error)
2253badlist:
2254        __(li arg_y,XCALLNOMATCH)
2255        /* b destructure_error */
2256destructure_error:
2257        __(mr vsp,imm4)         /* undo everything done to the stack */
2258        __(mr arg_z,whole_reg)
2259        __(set_nargs(2))
2260        __(b _SPksignalerr)
2261       
2262/* vpush the values in the value set atop the vsp, incrementing nargs. */
2263/* Discard the tsp frame; leave values atop the vsp. */
2264
2265_spentry(recover_values)
2266
2267/* First, walk the segments reversing the pointer to previous segment pointers */
2268/* Can tell the end because that previous segment pointer is the prev tsp pointer */
2269        __(ldr(imm0,tsp_frame.backlink(tsp))) /* previous tsp */
2270        __(mr imm1,tsp) /* current segment */
2271        __(mr imm2,tsp) /* last segment */
2272local_label(walkloop):
2273        __(ldr(imm3,12(imm1))) /* next segment */
2274        __(cmpr(cr0,imm0,imm3)) /* last segment? */
2275        __(str(imm2,12(imm1))) /* reverse pointer */
2276        __(mr imm2,imm1) /* last segment <- current segment */
2277        __(mr imm1,imm3) /* current segment <- next segment */
2278        __(bne cr0,local_label(walkloop))
2279
2280/* the final segment ptr is now in imm2 */
2281/* walk backwards, pushing values on VSP and incrementing NARGS */
2282local_label(pushloop):
2283        __(ldr(imm0,8(imm2))) /* nargs in segment */
2284        __(cmpri(cr0,imm0,0))
2285        __(cmpr(cr1,imm2,tsp))
2286        __(la imm3,16(imm2))
2287        __(add imm3,imm3,imm0)
2288        __(add nargs,nargs,imm0)
2289        __(b 2f)
22901:
2291        __(lwzu arg_z,-4(imm3))
2292        __(cmpri(cr0,imm0,fixnum_one))
2293        __(subi imm0,imm0,fixnum_one)
2294        __(vpush(arg_z))
22952:
2296        __(bne cr0,1b)
2297        __(ldr(imm2,12(imm2))) /* previous segment */
2298        __(bne cr1,local_label(pushloop))
2299        __(unlink(tsp))
2300        __(blr)
2301
2302       
2303/* Go out of line to do this.  Sheesh. */
2304
2305_spentry(vpopargregs)
2306        __(cmpri(cr0,nargs,0))
2307        __(cmpri(cr1,nargs,2<<fixnumshift))
2308        __(beqlr cr0)
2309        __(beq cr1,local_label(yz))
2310        __(blt cr1,local_label(z))
2311        __(ldr(arg_z,0(vsp)))
2312        __(ldr(arg_y,4(vsp)))
2313        __(ldr(arg_x,8(vsp)))
2314        __(la vsp,12(vsp))
2315        __(blr)
2316local_label(yz):
2317        __(ldr(arg_z,0(vsp)))
2318        __(ldr(arg_y,4(vsp)))
2319        __(la vsp,8(vsp))
2320        __(blr)
2321local_label(z):
2322        __(ldr(arg_z,0(vsp)))
2323        __(la vsp,4(vsp))
2324        __(blr)
2325
2326/* If arg_z is an integer, return in imm0 something whose sign */
2327/* is the same as arg_z's.  If not an integer, error. */
2328_spentry(integer_sign)
2329        __(extract_typecode(imm0,arg_z))
2330        __(cmpri(cr1,imm0,tag_fixnum))
2331        __(cmpri(cr0,imm0,subtag_bignum))
2332        __(mr imm0,arg_z)
2333        __(beqlr+ cr1)
2334        __(bne- cr0,1f)
2335        __(getvheader(imm0,arg_z))
2336        __(header_length(imm0,imm0)) /* boxed length = scaled size */
2337        __(addi imm0,imm0,misc_data_offset-4) /* bias, less 1 element */
2338        __(ldrx(imm0,arg_z,imm0))
2339        __(cmpri(cr0,imm0,0))
2340        __(li imm0,1)
2341        __(bgelr cr0)
2342        __(li imm0,-1)
2343        __(blr)
23441:
2345        __(uuo_interr(error_object_not_integer,arg_z))
2346
2347/* like misc_set, only pass the (boxed) subtag in temp0 */
2348_spentry(subtag_misc_set)
2349        __(trap_unless_fulltag_equal(arg_x,fulltag_misc,imm0))
2350        __(trap_unless_lisptag_equal(arg_y,tag_fixnum,imm0))
2351        __(vector_length(imm0,arg_x,imm1))
2352        __(trlge(arg_y,imm0))
2353        __(unbox_fixnum(imm1,temp0))
2354misc_set_common:
2355        __(extract_fulltag(imm2,imm1))
2356        __(cmpri(cr0,imm2,fulltag_nodeheader))
2357        __(cmpri(cr1,imm1,max_32_bit_ivector_subtag))
2358        __(cmpri(cr2,imm1,max_8_bit_ivector_subtag))
2359        __(addi imm0,arg_y,misc_data_offset)
2360        __(bne cr0,local_label(set_imm))
2361        /* A node vector. */
2362        __(strx(arg_z,arg_x,imm0))
2363        __(blr)
2364local_label(set_imm):
2365        __(extract_lisptag(imm2,arg_z))
2366        __(cmpri(cr7,imm2,tag_misc))
2367        __(cmpri(cr6,imm2,tag_imm))
2368        __(cmpri(cr5,imm2,tag_fixnum))
2369        __(bgt cr1,local_label(set_not32))
2370        __(cmpri(cr1,imm1,subtag_single_float_vector))
2371        __(cmpri(cr0,imm1,subtag_s32_vector))
2372        __(beq cr1,local_label(set_sfloat))
2373        __(beq cr0,local_label(set_signed))
2374        /* Either a non-negative fixnum, a one-digit bignum, or a two-digit */
2375        /* bignum whose sign-digit is 0 is ok. */
2376        __(srawi. imm1,arg_z,fixnum_shift)
2377        __(bne cr5,local_label(set_not_fixnum_u32))
2378        __(blt- cr0,local_label(set_bad))
2379local_label(set_set32):
2380        __(strx(imm1,arg_x,imm0))
2381        __(blr)
2382local_label(set_not_fixnum_u32):
2383        __(bne cr7,local_label(set_bad))
2384        __(extract_header(imm2,arg_z))
2385        __(cmpri(cr0,imm2,one_digit_bignum_header))
2386        __(cmpri(cr1,imm2,two_digit_bignum_header))
2387        __(vrefr(imm1,arg_z,0))
2388        __(cmpri(cr2,imm1,0))
2389        __(bne cr0,local_label(set_not_1_digit))
2390        __(bge cr2,local_label(set_set32))
2391        __(b local_label(set_bad))
2392local_label(set_not_1_digit):
2393        __(bne- cr1,local_label(set_bad))
2394        __(vrefr(imm2,arg_z,1))
2395        __(cmpri(cr0,imm2,0))
2396        __(bne- cr1,local_label(set_bad))
2397        __(beq cr0,local_label(set_set32))
2398local_label(set_bad):
2399        /* arg_z does not match the array-element-type of arg_x. */
2400        __(mr arg_y,arg_z)
2401        __(mr arg_z,arg_x)
2402        __(li arg_x,XNOTELT)
2403        __(set_nargs(3))
2404        __(b _SPksignalerr)
2405local_label(set_signed):
2406        __(unbox_fixnum(imm1,arg_z))
2407        __(beq cr5,local_label(set_set32))
2408        __(bne cr7,local_label(set_bad))
2409        __(extract_header(imm2,arg_z))
2410        __(cmpri(cr0,imm2,one_digit_bignum_header))
2411        __(vrefr(imm1,arg_z,0))
2412        __(bne- cr0,local_label(set_bad))
2413        __(strx(imm1,arg_x,imm0))
2414        __(blr)
2415local_label(set_sfloat):
2416        __(bne- cr7,local_label(set_bad))
2417        __(extract_header(imm2,arg_z))
2418        __(cmpri(cr0,imm2,single_float_header))
2419        __(bne- cr0,local_label(set_bad))
2420        __(ldr(imm1,single_float.value(arg_z)))
2421        __(strx(imm1,arg_x,imm0))
2422        __(blr)
2423       
2424local_label(set_not32):
2425        __(cmpri(cr1,imm1,max_16_bit_ivector_subtag))
2426        __(bgt cr2,local_label(set_not8))
2427        /* 8-bit objects are either u8, s8, or base_strings. */
2428        /* cr2_eq is set if base_string (= max_8_bit_ivector_subtag) */
2429        __(cmpri(cr1,imm1,subtag_s8_vector))
2430        __(extract_lisptag(imm2,arg_z))
2431        __(srwi imm0,arg_y,2)
2432        __(la imm0,misc_data_offset(imm0))
2433        __(extract_unsigned_byte_bits_(imm1,arg_z,8))
2434        __(beq cr2,local_label(set_char8))
2435        __(beq cr1,local_label(set_signed8))
2436        __(unbox_fixnum(imm1,arg_z))
2437        __(bne- cr0,local_label(set_bad))
2438        __(stbx imm1,arg_x,imm0)
2439        __(blr)
2440local_label(set_char8):
2441        __(extract_lowbyte(imm2,arg_z))
2442        __(cmpri(cr2,imm2,subtag_character))
2443        __(srwi imm1,arg_z,charcode_shift)
2444        __(bne- cr2,local_label(set_bad))
2445        __(stbx imm1,arg_x,imm0)
2446        __(blr)
2447local_label(set_signed8):
2448        __(unbox_fixnum(imm1,arg_z))
2449        __(extsb imm2,imm1)
2450        __(cmpr(cr0,imm2,imm1))
2451        __(bne- cr5,local_label(set_bad))
2452        __(bne- cr0,local_label(set_bad))
2453        __(stbx imm1,arg_x,imm0)
2454        __(blr)
2455local_label(set_not8):
2456        __(cmpri(cr2,imm1,subtag_bit_vector))
2457        __(bgt cr1,local_label(set_not16))
2458/* 16-bit objects are either u16, s16, or general_strings. */
2459/* cr1_eq is set if s16_vector (= max_16_bit_ivector_subtag) */
2460        __(cmpri(cr0,imm1,subtag_simple_general_string))
2461        __(srwi imm0,arg_y,1)
2462        __(la imm0,misc_data_offset(imm0))
2463        __(beq cr1,local_label(set_s16))
2464        __(beq cr0,local_label(set_char16))
2465        __(extract_unsigned_byte_bits_(imm1,arg_z,16))
2466        __(unbox_fixnum(imm1,arg_z))
2467        __(bne- cr0,local_label(set_bad))
2468        __(sthx imm1,arg_x,imm0)
2469        __(blr)
2470local_label(set_s16):
2471        __(unbox_fixnum(imm1,arg_z))
2472        __(extsh imm2,imm1)
2473        __(cmpr(cr0,imm2,imm1))
2474        __(bne- cr5,local_label(set_bad))
2475        __(bne- cr0,local_label(set_bad))
2476        __(sthx imm1,arg_x,imm0)
2477        __(blr)
2478local_label(set_char16):
2479        __(extract_lowbyte(imm2,arg_z))
2480        __(cmpri(cr0,imm2,subtag_character))
2481        __(srwi imm1,arg_z,charcode_shift)
2482        __(bne- cr0,local_label(set_bad))
2483        __(sthx imm1,arg_x,imm0)
2484        __(blr)
2485local_label(set_not16):
2486        __(bne cr2,local_label(set_dfloat))
2487        /* Bit vector case. */
2488        __(cmplri(cr2,arg_z,fixnumone))   /* nothing not a (boxed) bit  */
2489        __(extrwi imm1,arg_y,5,32-(fixnumshift+5))      /* imm1 = bitnum */
2490        __(extlwi imm2,arg_z,1,31-fixnumshift)
2491        __(srw imm2,imm2,imm1)
2492        __(lis imm3,0x8000)
2493        __(rlwinm imm0,arg_y,32-5,5,31-fixnumshift)
2494        __(la imm0,misc_data_offset(imm0))
2495        __(srw imm3,imm3,imm1)
2496        __(bgt- cr2,local_label(set_bad))
2497        __(ldrx(imm1,arg_x,imm0))
2498        __(andc imm1,imm1,imm3)
2499        __(or imm1,imm1,imm2)
2500        __(strx(imm1,arg_x,imm0))
2501        __(blr)
2502
2503local_label(set_dfloat):
2504        __(bne- cr7,local_label(set_bad))               /* not tag_misc */
2505        __(extract_header(imm2,arg_z))
2506        __(cmpri(cr0,imm2,double_float_header))
2507        __(slwi imm0,arg_y,1)  /* imm0 gets index * 2 */
2508        __(la imm0,misc_dfloat_offset(imm0)) /* + offset */
2509        __(bne- cr0,local_label(set_bad))
2510        __(ldr(imm1,double_float.value(arg_z))) /* get value parts */
2511        __(ldr(imm2,double_float.value+4(arg_z)))
2512        __(strx(imm1,arg_x,imm0))
2513        __(la imm0,4(imm0))
2514        __(strx(imm2,arg_x,imm0))
2515        __(blr)
2516       
2517
2518/* "spread" the lexpr in arg_z.
2519   ppc2-invoke-fn assumes that temp1 is preserved here. */
2520_spentry(spread_lexprz)
2521        __(ldr(imm0,0(arg_z)))
2522        __(cmpri(cr3,imm0,3<<fixnumshift))
2523        __(cmpri(cr4,imm0,2<<fixnumshift))
2524        __(add imm1,arg_z,imm0)
2525        __(cmpri(cr0,imm0,0))
2526        __(add nargs,nargs,imm0)
2527        __(cmpri(cr1,nargs,0))
2528        __(cmpri(cr2,nargs,2<<fixnumshift))
2529        __(la imm1,4(imm1))
2530        __(bge cr3,9f)
2531        __(beq cr4,2f)
2532        __(bne cr0,1f)
2533        /* lexpr count was 0; vpop the arg regs that */
2534        /* were vpushed by the caller */
2535        __(beqlr cr1)
2536        __(vpop(arg_z))
2537        __(bltlr cr2)
2538        __(vpop(arg_y))
2539        __(beqlr cr2)
2540        __(vpop(arg_x))
2541        __(blr)
2542
2543        /* vpush args from the lexpr until we have only */
2544        /* three left, then assign them to arg_x, arg_y, */
2545        /* and arg_z. */
25468:
2547        __(cmpri(cr3,imm0,4<<fixnumshift))
2548        __(subi imm0,imm0,fixnumone)
2549        __(lwzu arg_z,-4(imm1))
2550        __(vpush(arg_z))
25519:
2552        __(bne cr3,8b)
2553        __(ldr(arg_x,-4(imm1)))
2554        __(ldr(arg_y,-8(imm1)))
2555        __(ldr(arg_z,-12(imm1)))
2556        __(blr)
2557
2558        /* lexpr count is two: set arg_y, arg_z from the */
2559        /* lexpr, maybe vpop arg_x */
25602:     
2561        __(ldr(arg_y,-4(imm1)))
2562        __(ldr(arg_z,-8(imm1)))
2563        __(beqlr cr2)           /* return if (new) nargs = 2 */
2564        __(vpop(arg_x))
2565        __(blr)
2566
2567        /* lexpr count is one: set arg_z from the lexpr, */
2568        /* maybe vpop arg_y, arg_x */
25691:     
2570        __(ldr(arg_z,-4(imm1)))
2571        __(bltlr cr2)           /* return if (new) nargs < 2 */
2572        __(vpop(arg_y))
2573        __(beqlr cr2)           /* return if (new) nargs = 2 */
2574        __(vpop(arg_x))
2575        __(blr)
2576       
2577/* Set the special variable in arg_y to the value in arg_z.
2578   Error if arg_y is a constant.
2579   arg_y is a known, non-nil symbol. */
2580_spentry(setqsym)
2581               
2582_spentry(reset)
2583        .globl _SPthrow
2584        __(nop)
2585        __(ref_nrs_value(temp0,toplcatch))
2586        __(li temp1,XSTKOVER)
2587        __(vpush(temp0))
2588        __(vpush(temp1))
2589        __(set_nargs(1))
2590        __(b _SPthrow)
2591
2592       
2593/* "slide" nargs worth of values up the vstack.  IMM0 contains */
2594/* the difference between the current VSP and the target. */
2595_spentry(mvslide)
2596        __(cmpri(cr0,nargs,0))
2597        __(mr imm3,nargs)
2598        __(add imm2,vsp,nargs)
2599        __(add imm2,imm2,imm0)
2600        __(add imm0,vsp,nargs)
2601        __(beq 2f)
26021:
2603        __(cmpri(cr0,imm3,1<<fixnumshift))
2604        __(subi imm3,imm3,1<<fixnumshift)
2605        __(lwzu temp0,-4(imm0))
2606        __(stwu temp0,-4(imm2))
2607        __(bne cr0,1b)
26082:
2609        __(mr vsp,imm2)
2610        __(blr)
2611
2612/* Build a new TSP area to hold nargs worth of multiple-values. */
2613/* Pop the multiple values off of the vstack. */
2614/* The new TSP frame will look like this: */
2615/*
2616+--------+-------+-------+---------+--------+--------+--------+======+----------+
2617| ptr to | zero  | nargs | ptr to  | valn-1 | valn-2 | val-0  | ???? | prev TSP |
2618|  prev  |       |       |  prev   |        |        |        | fill |          |
2619| TSP    |       |       | segment |        |        |        |      |          |
2620+--------+-------+-------+---------+--------+--------+--------+------+----------+
2621 */
2622/* e.g., the first multiple value goes in the last cell in the frame, the */
2623/* count of values goes in the first word, and the word after the value count */
2624/* is 0 if the number of values is even (for alignment). */
2625/* Subsequent calls to .SPadd_values preserve this alignment. */
2626/* .SPrecover_values is therefore pretty simple. */
2627
2628_spentry(save_values)
2629        __(mr imm1,tsp)
2630
2631/* common exit: nargs = values in this set, imm1 = ptr to tsp before call to save_values */
2632local_label(save_values_to_tsp):
2633        __(mr imm2,tsp)
2634        __(dnode_align(imm0,nargs,tsp_frame.fixed_overhead+8)) /* count, link */
2635        __(TSP_Alloc_Var_Boxed_nz(imm0,imm3))
2636        __(str(imm1,tsp_frame.backlink(tsp))) /* keep one tsp "frame" as far as rest of lisp is concerned */
2637        __(str(nargs,tsp_frame.data_offset(tsp)))
2638        __(str(imm2,tsp_frame.data_offset+4(tsp))) /* previous tsp */
2639        __(la imm3,tsp_frame.data_offset+8(tsp))
2640        __(add imm3,imm3,nargs)
2641        __(add imm0,vsp,nargs)
2642        __(cmpr(cr0,imm0,vsp))
2643        __(b 2f)
26441:
2645        __(lwzu arg_z,-4(imm0))
2646        __(cmpr(cr0,imm0,vsp))
2647        __(stwu arg_z,-4(imm3))
26482:
2649        __(bne cr0,1b)
2650        __(add vsp,vsp,nargs) /*  discard values */
2651        __(blr)
2652       
2653
2654/* Add the multiple values that are on top of the vstack to the set */
2655/* saved in the top tsp frame, popping them off of the vstack in the */
2656/* process.  It is an error (a bad one) if the TSP contains something */
2657/* other than a previously saved set of multiple-values. */
2658/* Since adding to the TSP may cause a new TSP segment to be allocated, */
2659/* each add_values call adds another linked element to the list of */
2660/* values. This makes recover_values harder. */
2661
2662_spentry(add_values)
2663        __(cmpri(cr0,nargs,0))
2664        __(ldr(imm1,0(tsp)))
2665        __(bne cr0,local_label(save_values_to_tsp))
2666        __(blr)
2667       
2668/* On entry, R11->callback-index */
2669/* Restore lisp context, then funcall #'%pascal-functions% with */
2670/* two args: callback-index, args-ptr (a macptr pointing to the args on the stack) */
2671_spentry(callback)
2672        /* Save C argument registers */
2673        __(str(r3,c_frame.param0(sp)))
2674        __(str(r4,c_frame.param1(sp)))
2675        __(str(r5,c_frame.param2(sp)))
2676        __(str(r6,c_frame.param3(sp)))
2677        __(str(r7,c_frame.param4(sp)))
2678        __(str(r8,c_frame.param5(sp)))
2679        __(str(r9,c_frame.param6(sp)))
2680        __(str(r10,c_frame.param7(sp)))
2681        __(mflr imm3)
2682        __(str(imm3,c_frame.savelr(sp)))
2683        __(mfcr imm0)
2684        __(str(imm0,c_frame.crsave(sp)))
2685
2686        /* Save the non-volatile registers on the sp stack */
2687        /* This is a non-standard stack frame, but noone will ever see it, */
2688        /* so it doesn't matter. It will look like more of the stack frame pushed below. */
2689        __(stru(sp,-(stack_align(c_reg_save.size))(sp)))
2690        __(stmw r13,c_reg_save.save_gprs(sp))
2691        __(check_stack_alignment(r0))
2692        __(mffs f0)
2693        __(stfd f0,c_reg_save.save_fp_zero(sp))
2694        __(ldr(r31,c_reg_save.save_fp_zero+4(sp)))      /* recover FPSCR image */
2695        __(str(r31,c_reg_save.save_fpscr(sp)))
2696        __(lwi(r30,0x43300000))
2697        __(lwi(r31,0x80000000))
2698        __(str(r30,c_reg_save.save_fp_zero(sp)))
2699        __(str(r31,c_reg_save.save_fp_zero+4(sp)))
2700        __(stfd fp_s32conv,c_reg_save.save_fps32conv(sp))
2701        __(lfd fp_s32conv,c_reg_save.save_fp_zero(sp))
2702        __(stfd fp_zero,c_reg_save.save_fp_zero(sp))
2703        __(lfs fp_zero,lisp_globals.short_float_zero(0))        /* ensure that fp_zero contains 0.0 */
2704
2705/* Restore rest of Lisp context. */
2706/* Could spread out the memory references here to gain a little speed */
2707
2708        __(li loc_pc,0)
2709        __(li fn,0)                     /* subprim, not a lisp function */
2710        __(li temp4,0)
2711        __(li temp3,0)
2712        __(li temp2,0)
2713        __(li temp1,0)
2714        __(li temp0,0)
2715        __(li arg_x,0)
2716        __(box_fixnum(arg_y,r11))       /* callback-index */
2717        __(la arg_z,stack_align(c_reg_save.size)+c_frame.param0(sp))    /* parameters (tagged as a fixnum) */
2718
2719        /* Recover lisp thread context. Have to call C code to do so. */
2720        __(ref_global(r12,get_tcr))
2721        __(mtctr r12)
2722        __(li r3,1)
2723        __(stru(sp,-(stack_align(c_frame.minsiz))(sp)))
2724        __(bctrl)
2725        __(mr rcontext,r3)
2726        __(la sp,(stack_align(c_frame.minsiz))(sp))
2727
2728        __(ldr(vsp,tcr.save_vsp(rcontext)))
2729        __(ldr(tsp,tcr.save_tsp(rcontext)))             
2730        __(li rzero,0)
2731        __(mtxer rzero) /* lisp wants the overflow bit being clear */
2732        __(li imm0,TCR_STATE_LISP)
2733        __(li save0,0)
2734        __(li save1,0)
2735        __(li save2,0)
2736        __(li save3,0)
2737        __(li save4,0)
2738        __(li save5,0)
2739        __(li save6,0)
2740        __(li save7,0)
2741        __(lfd f0,tcr.lisp_fpscr(rcontext))
2742        __(mtfsf 0xff,f0)
2743        __(li allocbase,0)
2744        __(li allocptr,0)       
2745        __(str(imm0,tcr.valence(rcontext)))
2746        __(ldr(allocptr,tcr.save_allocptr(rcontext)))
2747        __(ldr(allocbase,tcr.save_allocbase(rcontext)))
2748
2749        /* load nargs and callback to the lisp */
2750        __(set_nargs(2))
2751        __(ldr(imm2,tcr.cs_area(rcontext)))
2752        __(ldr(imm4,area.active(imm2)))
2753        __(stru(imm4,-lisp_frame.size(sp)))
2754        __(str(imm3,lisp_frame.savelr(sp)))
2755        __(str(vsp,lisp_frame.savevsp(sp)))     /* for stack overflow code */
2756        __(li fname,nrs.callbacks)      /* %pascal-functions% */
2757        __(call_fname)
2758        __(ldr(imm2,lisp_frame.backlink(sp)))
2759        __(ldr(imm3,tcr.cs_area(rcontext)))
2760        __(str(imm2,area.active(imm3)))
2761        __(discard_lisp_frame())
2762        /* save_vsp will be restored from ff_call's stack frame, but */
2763        /* I included it here for consistency. */
2764        /* save_tsp is set below after we exit Lisp context. */
2765        __(str(allocptr,tcr.save_allocptr(rcontext)))
2766        __(str(allocbase,tcr.save_allocbase(rcontext)))
2767        __(str(vsp,tcr.save_vsp(rcontext)))
2768        __(str(tsp,tcr.save_tsp(rcontext)))
2769        /* Exit lisp context */
2770        __(li imm1,TCR_STATE_FOREIGN)
2771        __(str(imm1,tcr.valence(rcontext)))
2772        /* Restore the non-volatile registers & fpscr */
2773        __(lfd fp_zero,c_reg_save.save_fp_zero(sp))
2774        __(ldr(r31,c_reg_save.save_fpscr(sp)))
2775        __(str(r31,c_reg_save.save_fp_zero+4(sp)))
2776        __(lfd f0,c_reg_save.save_fp_zero(sp))
2777        __(mtfsf 0xff,f0)
2778        __(lmw r13,c_reg_save.save_gprs(sp))
2779        __(lfd fp_s32conv,c_reg_save.save_fps32conv(sp))
2780        __(ldr(sp,0(sp)))
2781        __(ldr(r3,c_frame.param0(sp)))
2782        __(ldr(r4,c_frame.param0(sp)))
2783        __(ldr(r5,c_frame.savelr(sp)))
2784        __(mtlr r5)
2785        __(ldr(r5,c_frame.crsave(sp)))
2786        __(mtcr r5)
2787        __(blr)
2788       
2789/* Like misc_alloc (a LOT like it, since it does most of the work), but takes */
2790/* an initial-value arg in arg_z, element_count in arg_x, subtag in arg_y. */
2791/* Calls out to %init-misc, which does the rest of the work. */
2792
2793_spentry(misc_alloc_init)
2794        __(mflr loc_pc)
2795        __(build_lisp_frame(fn,loc_pc,vsp))
2796        __(li fn,0)
2797        __(mr temp0,arg_z)              /* initval */
2798        __(mr arg_z,arg_y)              /* subtag */
2799        __(mr arg_y,arg_x)              /* element-count */
2800        __(bl _SPmisc_alloc)
2801        __(ldr(loc_pc,lisp_frame.savelr(sp)))
2802        __(mtlr loc_pc)
2803        __(ldr(fn,lisp_frame.savefn(sp)))
2804        __(ldr(vsp,lisp_frame.savevsp(sp))) /* vsp may have moved to the bottom of a new stack segment */
2805        __(discard_lisp_frame())
2806        __(li fname,nrs.init_misc)
2807        __(set_nargs(2))
2808        __(mr arg_y,temp0)
2809        __(jump_fname())
2810
2811/* As in stack_misc_alloc above, only with a non-default initial-value. */
2812
2813_spentry(stack_misc_alloc_init)
2814        __(mflr loc_pc)
2815        __(build_lisp_frame(fn,loc_pc,vsp))
2816        __(li fn,0)
2817        __(mr temp0,arg_z) /* initval */
2818        __(mr arg_z,arg_y) /* subtag */
2819        __(mr arg_y,arg_x) /* element-count */
2820        __(bl _SPstack_misc_alloc)
2821        __(ldr(loc_pc,lisp_frame.savelr(sp)))
2822        __(mtlr loc_pc)
2823        __(ldr(fn,lisp_frame.savefn(sp)))
2824        __(ldr(vsp,lisp_frame.savevsp(sp))) /* vsp may have changed due to overflowing a stack segment */
2825        __(discard_lisp_frame())
2826        __(li fname,nrs.init_misc)
2827        __(set_nargs(2))
2828        __(mr arg_y,temp0)
2829        __(jump_fname())
2830
2831/* save the values of a list of special variables (arg_y); set them
2832   to the corresponding values in the list in arg_z.
2833   We've checked to make sure that arg_y is a proper list of bindable
2834   symbols, but we're not sure what's in arg_z.
2835   Save the special binding triplets on the tstack.  If there's not
2836   enough room, die.  Prepend the triplets with a boxed triplet
2837   count. */
2838_spentry(progvsave)
2839        /* Error if arg_z isn't a proper list.  That's unlikely,
2840           but it's better to check now than to crash later.
2841        */
2842        __(cmpri(arg_z,nil_value))
2843        __(mr temp0,arg_z)      /* fast */
2844        __(mr temp1,arg_z)      /* slow */
2845        __(beq 9f)              /* Null list is proper */
28460:     
2847        __(trap_unless_list(temp0,imm0))
2848        __(_cdr(temp2,temp0))   /* (null (cdr fast)) ? */
2849        __(cmpri(temp2,nil_value))
2850        __(trap_unless_list(temp2,imm0))
2851        __(_cdr(temp0,temp2))
2852        __(beq 9f)
2853        __(_cdr(temp1,temp1))
2854        __(cmpr(temp0,temp1))
2855        __(bne 0b)
2856        __(lwi(arg_y,XIMPROPERLIST))
2857        __(set_nargs(2))
2858        __(b _SPksignalerr)
28599:      /* Whew */     
2860       
2861        /* Next, determine the length of arg_y.  We */
2862        /* know that it's a proper list. */
2863        __(li imm0,-4)
2864        __(mr temp0,arg_y)
28651:
2866        __(cmpri(cr0,temp0,nil_value))
2867        __(la imm0,4(imm0))
2868        __(_cdr(temp0,temp0))
2869        __(bne 1b)
2870        /* imm0 is now (boxed) triplet count. */
2871        /* Determine word count, add 1 (to align), and make room. */
2872        /* if count is 0, make an empty tsp frame and exit */
2873        __(cmpri(cr0,imm0,0))
2874        __(add imm1,imm0,imm0)
2875        __(add imm1,imm1,imm0)
2876        __(dnode_align(imm1,imm1,node_size))
2877        __(bne+ cr0,2f)
2878         __(TSP_Alloc_Fixed_Boxed(8))
2879         __(blr)
28802:
2881        __(la imm1,tsp_frame.fixed_overhead(imm1))      /* tsp header */
2882        __(TSP_Alloc_Var_Boxed_nz(imm1,imm2))
2883        __(str(imm0,tsp_frame.data_offset(tsp)))
2884        __(ldr(imm2,tsp_frame.backlink(tsp)))
2885        __(mr temp0,arg_y)
2886        __(ldr(imm1,tcr.db_link(rcontext)))
28873:
2888        __(_car(temp1,temp0))
2889        __(ldr(imm0,symbol.flags(temp1)))
2890        __(ori imm0,imm0,sym_vbit_bound_mask)
2891        __(_cdr(temp0,temp0))
2892        __(_car(temp2,arg_z))
2893        __(_cdr(arg_z,arg_z))
2894        __(cmpri(cr0,temp0,nil_value))
2895        __(push(temp2,imm2))
2896        __(push(temp1,imm2))
2897        __(push(imm1,imm2))
2898        __(mr imm1,imm2)
2899        __(str(imm0,symbol.flags(temp1)))
2900        __(bne cr0,3b)
2901        __(str(imm1,tcr.db_link(rcontext)))
2902        __(blr)
2903       
2904/*
2905   Restore the special bindings from the top of the tstack,
2906   leaving the tstack frame allocated.
2907   Note that there might be 0 saved bindings, in which case
2908   do nothing.
2909   Note also that this is -only- called from an unwind-protect
2910   cleanup form, and that .SPnthrowXXX is keeping one or more
2911   values in a frame on top of the tstack.
2912*/
2913       
2914_spentry(progvrestore)
2915        __(ldr(imm0,tsp_frame.backlink(tsp)))   /* ignore .SPnthrowXXX values frame */
2916        __(ldr(imm0,tsp_frame.data_offset(imm0)))
2917        __(cmpri(cr0,imm0,0))
2918        __(unbox_fixnum(imm0,imm0))
2919        __(bne+ cr0,_SPunbind_n)
2920        __(blr)
2921
2922_spentry(callbuiltin)
2923        __(ref_nrs_value(fname,builtin_functions))
2924        __(la imm0,misc_data_offset(imm0))
2925        __(ldrx(fname,fname,imm0))
2926        __(jump_fname())
2927
2928/* the value of the nilreg-relative symbol %builtin-functions% should be */
2929/* a vector of symbols.  Call the symbol indexed by imm0 (boxed) and */
2930/* return a single value. */
2931
2932_spentry(callbuiltin0)
2933        __(set_nargs(0))
2934        __(ref_nrs_value(fname,builtin_functions))
2935        __(la imm0,misc_data_offset(imm0))
2936        __(ldrx(fname,fname,imm0))
2937        __(jump_fname())
2938
2939_spentry(callbuiltin1)
2940        __(ref_nrs_value(fname,builtin_functions))
2941        __(set_nargs(1))
2942        __(la imm0,misc_data_offset(imm0))
2943        __(ldrx(fname,fname,imm0))
2944        __(jump_fname())
2945
2946_spentry(callbuiltin2)
2947        __(set_nargs(2))
2948        __(ref_nrs_value(fname,builtin_functions))
2949        __(la imm0,misc_data_offset(imm0))
2950        __(ldrx(fname,fname,imm0))
2951        __(jump_fname())
2952
2953
2954_spentry(callbuiltin3)
2955        __(set_nargs(3))
2956        __(ref_nrs_value(fname,builtin_functions))
2957        __(la imm0,misc_data_offset(imm0))
2958        __(ldrx(fname,fname,imm0))
2959        __(jump_fname())
2960       
2961
2962_spentry(popj)
2963        .globl C(popj)
2964C(popj):
2965        __(ldr(loc_pc,lisp_frame.savelr(sp)))
2966        __(ldr(vsp,lisp_frame.savevsp(sp)))
2967        __(mtlr loc_pc)
2968        __(ldr(fn,lisp_frame.savefn(sp)))
2969        __(discard_lisp_frame())
2970        __(blr)
2971
2972_spentry(restorefullcontext)
2973        __(mflr loc_pc)
2974        __(mtctr loc_pc)
2975        __(ldr(loc_pc,lisp_frame.savelr(sp)))
2976        __(mtlr loc_pc)
2977        __(ldr(vsp,lisp_frame.savevsp(sp)))
2978        __(ldr(fn,lisp_frame.savefn(sp)))
2979        __(discard_lisp_frame())
2980        __(bctr)
2981
2982_spentry(savecontextvsp)
2983        __(ldr(imm0,tcr.cs_limit(rcontext)))
2984        __(build_lisp_frame(fn,loc_pc,vsp))
2985        __(mr fn,nfn)
2986        __(trllt(sp,imm0))
2987        __(blr)
2988
2989_spentry(savecontext0)
2990        __(add imm0,vsp,imm0)
2991        __(build_lisp_frame(fn,loc_pc,imm0))
2992        __(ldr(imm0,tcr.cs_limit(rcontext)))
2993        __(mr fn,nfn)
2994        __(trllt(sp,imm0))
2995        __(blr)
2996
2997
2998/* Like .SPrestorefullcontext, only the saved return address */
2999/* winds up in loc-pc instead of getting thrashed around ... */
3000_spentry(restorecontext)
3001        __(ldr(loc_pc,lisp_frame.savelr(sp)))
3002        __(ldr(vsp,lisp_frame.savevsp(sp)))
3003        __(ldr(fn,lisp_frame.savefn(sp)))
3004        __(discard_lisp_frame())
3005        __(blr)
3006
3007       
3008/* Nargs is valid; all arg regs, lexpr-count pushed by caller. */
3009/* imm0 = vsp to restore. */
3010/* Return all values returned by caller to its caller, hiding */
3011/* the variable-length arglist. */
3012/* If we can detect that the caller's caller didn't expect */
3013/* multiple values, then things are even simpler. */
3014_spentry(lexpr_entry)
3015        __(ref_global(imm1,ret1val_addr))
3016        __(cmpr(cr0,imm1,loc_pc))
3017        __(build_lisp_frame(fn,loc_pc,imm0))
3018        __(bne cr0,1f)
3019        __(ref_global(imm0,lexpr_return))
3020        __(build_lisp_frame(rzero,imm0,vsp))
3021        __(mr loc_pc,imm1)
3022        __(ldr(imm0,tcr.cs_limit(rcontext)))
3023        __(trllt(sp,imm0))
3024        __(li fn,0)
3025        __(blr)
3026
3027/* The single-value case just needs to return to something that'll pop */
3028/* the variable-length frame off of the vstack. */
30291:
3030        __(ref_global(loc_pc,lexpr_return1v))
3031        __(ldr(imm0,tcr.cs_limit(rcontext)))
3032        __(trllt(sp,imm0))
3033        __(li fn,0)
3034        __(blr)
3035
3036/*
3037  Do a system call in Darwin.  The stack is set up much as it would be
3038  for a PowerOpen ABI ff-call:  register parameters are in the stack
3039  frame, and there are 4 extra words at the bottom of the frame that
3040  we can carve a lisp frame out of.
3041
3042  System call return conventions are a little funky in Darwin: if "@sc"
3043  is the address of the "sc" instruction, errors return to @sc+4 and
3044  non-error cases return to @sc+8.  Error values are returned as
3045  positive values in r3; this is true even if the system call returns
3046  a doubleword (64-bit) result.  Since r3 would ordinarily contain
3047  the high half of a doubleword result, this has to be special-cased.
3048
3049  The caller should set the c_frame.crsave field of the stack frame
3050  to 0 if the result is to be interpreted as anything but a doubleword
3051  and to non-zero otherwise.  (This only matters on an error return.)
3052*/
3053       
3054_spentry(darwin_syscall)
3055        __(mflr loc_pc)
3056        __(vpush_saveregs())
3057        __(ldr(imm1,0(sp)))
3058        __(la imm2,-lisp_frame.size(imm1))
3059        __(zero_doublewords imm2,0,lisp_frame.size)
3060        __(str(imm1,lisp_frame.backlink(imm2)))
3061        __(str(imm2,c_frame.backlink(sp)))
3062        __(str(fn,lisp_frame.savefn(imm2)))
3063        __(str(loc_pc,lisp_frame.savelr(imm2)))
3064        __(str(vsp,lisp_frame.savevsp(imm2)))
3065        __(ldr(imm3,tcr.cs_area(rcontext)))
3066        __(str(imm2,area.active(imm3)))
3067        __(str(allocptr,tcr.save_allocptr(rcontext)))
3068        __(str(allocbase,tcr.save_allocbase(rcontext)))
3069        __(str(tsp,tcr.save_tsp(rcontext)))
3070        __(str(vsp,tcr.save_vsp(rcontext)))
3071        __(str(rzero,tcr.ffi_exception(rcontext)))
3072        __(mr save0,rcontext)
3073        __(li r3,TCR_STATE_FOREIGN)
3074        __(str(r3,tcr.valence(rcontext)))
3075        __(li rcontext,0)
3076        __(ldr(r3,c_frame.param0(sp)))
3077        __(ldr(r4,c_frame.param1(sp)))
3078        __(ldr(r5,c_frame.param2(sp)))
3079        __(ldr(r6,c_frame.param3(sp)))
3080        __(ldr(r7,c_frame.param4(sp)))
3081        __(ldr(r8,c_frame.param5(sp)))
3082        __(ldr(r9,c_frame.param6(sp)))
3083        __(ldr(r10,c_frame.param7(sp)))
3084        __(unbox_fixnum(r0,arg_z))
3085        __(sc)
3086        __(b 1f)
3087        __(b 9f)
30881:
3089        __(ldr(imm2,c_frame.crsave(sp)))
3090        __(cmpri(cr0,imm2,0))
3091        __(bne cr0,2f)
3092        /* 32-bit result */
3093        __(neg r3,r3)
3094        __(b 9f)
30952:
3096        /* 64-bit result */
3097        __(neg r4,r3)
3098        __(li r3,-1)
3099
31009:
3101        __(mr imm2,save0)       /* recover context */
3102        __(ldr(sp,c_frame.backlink(sp)))
3103        __(li imm4,TCR_STATE_LISP)
3104        __(li rzero,0)
3105        __(li loc_pc,0)
3106        __(li arg_x,nil_value)
3107        __(li arg_y,nil_value)
3108        __(li arg_z,nil_value)
3109        __(li temp0,nil_value)
3110        __(li temp1,nil_value)
3111        __(li temp2,nil_value)
3112        __(li temp3,nil_value)
3113        __(li temp4,nil_value)
3114        __(li fn,nil_value)
3115        __(vpop_saveregs)
3116        __(mr rcontext,imm2)
3117        __(ldr(allocptr,tcr.save_allocptr(rcontext)))
3118        __(ldr(allocbase,tcr.save_allocbase(rcontext)))
3119        __(ldr(tsp,tcr.save_tsp(rcontext)))
3120        __(str(imm4,tcr.valence(rcontext)))
3121        __(ldr(loc_pc,lisp_frame.savelr(sp)))
3122        __(mtlr loc_pc)
3123        __(ldr(fn,lisp_frame.savefn(sp)))
3124        __(discard_lisp_frame)
3125        __(check_pending_interrupt([cr1]))
3126        __(blr)
3127       
3128       
3129_spentry(builtin_plus)
3130        __(extract_lisptag(imm0,arg_y))
3131        __(extract_lisptag(imm1,arg_z))
3132        __(cmpri(cr0,imm0,tag_fixnum))
3133        __(cmpri(cr1,imm1,tag_fixnum))
3134        __(bne- cr0,1f)
3135        __(bne- cr1,1f)
3136        __(addo. arg_z,arg_y,arg_z)
3137        __(bnslr+)
3138        __(mtxer rzero)
3139        __(unbox_fixnum(imm1,arg_z))
3140        __(xoris imm1,imm1,0xc000)
3141        __(li imm0,one_digit_bignum_header)
3142        __(Misc_Alloc_Fixed(arg_z,imm0,8))
3143        __(str(imm1,misc_data_offset(arg_z)))
3144        __(blr)
31451:
3146        __(jump_builtin(_builtin_plus,2))
3147_spentry(builtin_minus)
3148        __(extract_lisptag(imm0,arg_y))
3149        __(extract_lisptag(imm1,arg_z))
3150        __(cmpri(cr0,imm0,tag_fixnum))
3151        __(cmpri(cr1,imm1,tag_fixnum))
3152        __(bne- cr0,1f)
3153        __(bne- cr1,1f)
3154        __(subo. arg_z,arg_y,arg_z)
3155        __(bnslr+)
3156        __(mtxer rzero)
3157        __(unbox_fixnum(imm1,arg_z))
3158        __(xoris imm1,imm1,0xc000)
3159        __(li imm0,one_digit_bignum_header)
3160        __(Misc_Alloc_Fixed(arg_z,imm0,8))
3161        __(str(imm1,misc_data_offset(arg_z)))
3162        __(blr)
31631:
3164        __(jump_builtin(_builtin_minus,2))
3165_spentry(builtin_times)
3166        __(extract_lisptag(imm0,arg_y))
3167        __(extract_lisptag(imm1,arg_z))
3168        __(cmpri(cr0,imm0,tag_fixnum))
3169        __(cmpri(cr1,imm1,tag_fixnum))
3170        __(unbox_fixnum(imm2,arg_y))
3171        __(bne cr0,1f)
3172        __(bne cr1,1f)
3173        __(mullwo. imm3,arg_z,imm2)
3174        __(bso 2f)              /*  SO set if result would overflow a fixnum */
3175        __(mr arg_z,imm3)
3176        __(blr)
3177        /* Args are fixnums; result can't be */
31782:      __(mtxer rzero)
3179        __(unbox_fixnum(imm3,arg_z))
3180        __(mullw imm1,imm3,imm2) /* imm1 = low  32 bits */
3181        __(mulhw imm0,imm3,imm2) /* imm0 = high 32 bits */
3182        __(b _SPmakes64)
3183
31841:      __(jump_builtin(_builtin_times,2))
3185
3186_spentry(builtin_div)
3187        __(jump_builtin(_builtin_div,2))
3188
3189_spentry(builtin_eq)
3190        __(extract_lisptag(imm0,arg_y))
3191        __(extract_lisptag(imm1,arg_z))
3192        __(cmpri(cr0,imm0,tag_fixnum))
3193        __(cmpri(cr1,imm1,tag_fixnum))
3194        __(cmpr(cr2,arg_y,arg_z))
3195        __(bne- cr0,1f)
3196        __(bne- cr1,1f)
3197        __(li arg_z,nil_value)
3198        __(bnelr cr2)
3199        __(li arg_z,t_value)
3200        __(blr)
32011:
3202        __(jump_builtin(_builtin_eq,2))
3203
3204_spentry(builtin_ne)
3205        __(extract_lisptag(imm0,arg_y))
3206        __(extract_lisptag(imm1,arg_z))
3207        __(cmpri(cr0,imm0,tag_fixnum))
3208        __(cmpri(cr1,imm1,tag_fixnum))
3209        __(cmpr(cr2,arg_y,arg_z))
3210        __(bne- cr0,1f)
3211        __(bne- cr1,1f)
3212        __(li arg_z,nil_value)
3213        __(beqlr cr2)
3214        __(li arg_z,t_value)
3215        __(blr)
32161:
3217        __(jump_builtin(_builtin_ne,2))
3218
3219_spentry(builtin_gt)
3220        __(extract_lisptag(imm0,arg_y))
3221        __(extract_lisptag(imm1,arg_z))
3222        __(cmpri(cr0,imm0,tag_fixnum))
3223        __(cmpri(cr1,imm1,tag_fixnum))
3224        __(cmpr(cr2,arg_y,arg_z))
3225        __(bne- cr0,1f)
3226        __(bne- cr1,1f)
3227        __(li arg_z,nil_value)
3228        __(bnglr cr2)
3229        __(li arg_z,t_value)
3230        __(blr)
32311:
3232        __(jump_builtin(_builtin_gt,2))
3233
3234_spentry(builtin_ge)
3235        __(extract_lisptag(imm0,arg_y))
3236        __(extract_lisptag(imm1,arg_z))
3237        __(cmpri(cr0,imm0,tag_fixnum))
3238        __(cmpri(cr1,imm1,tag_fixnum))
3239        __(cmpr(cr2,arg_y,arg_z))
3240        __(bne- cr0,1f)
3241        __(bne- cr1,1f)
3242        __(li arg_z,nil_value)
3243        __(bltlr cr2)
3244        __(li arg_z,t_value)
3245        __(blr)
32461:
3247        __(jump_builtin(_builtin_ge,2))
3248
3249_spentry(builtin_lt)
3250        __(extract_lisptag(imm0,arg_y))
3251        __(extract_lisptag(imm1,arg_z))
3252        __(cmpri(cr0,imm0,tag_fixnum))
3253        __(cmpri(cr1,imm1,tag_fixnum))
3254        __(cmpr(cr2,arg_y,arg_z))
3255        __(bne- cr0,1f)
3256        __(bne- cr1,1f)
3257        __(li arg_z,nil_value)
3258        __(bnllr cr2)
3259        __(li arg_z,t_value)
3260        __(blr)
32611:
3262        __(jump_builtin(_builtin_lt,2))
3263
3264_spentry(builtin_le)
3265        __(extract_lisptag(imm0,arg_y))
3266        __(extract_lisptag(imm1,arg_z))
3267        __(cmpri(cr0,imm0,tag_fixnum))
3268        __(cmpri(cr1,imm1,tag_fixnum))
3269        __(cmpr(cr2,arg_y,arg_z))
3270        __(bne- cr0,1f)
3271        __(bne- cr1,1f)
3272        __(li arg_z,nil_value)
3273        __(bgtlr cr2)
3274        __(li arg_z,t_value)
3275        __(blr)
32761:
3277        __(jump_builtin(_builtin_le,2))
3278
3279
3280_spentry(builtin_eql)
3281        __(cmpr(cr0,arg_y,arg_z))
3282        __(extract_lisptag(imm0,arg_y))
3283        __(extract_lisptag(imm1,arg_z))
3284        __(cmpr(cr1,imm0,imm1))
3285        __(beq cr0,1f)
3286        __(cmpri(cr0,imm0,tag_misc))
3287        __(bne cr1,2f)
3288        __(bne cr0,2f)
3289        __(jump_builtin(_builtin_eql,2))
32901:      __(li arg_z,t_value)
3291        __(blr)
32922:      __(li arg_z,nil_value)
3293        __(blr)
3294       
3295_spentry(builtin_length)
3296        __(extract_typecode(imm0,arg_z))
3297        __(cmpri(cr0,imm0,min_vector_subtag))
3298        __(cmpri(cr2,imm0,tag_list))
3299        __(beq- cr0,2f)
3300        __(blt- cr0,3f)
3301        /* (simple-array * (*)) */
3302        __(vector_length(arg_z,arg_z,imm0))
3303        __(blr)
33042:
3305        __(ldr(arg_z,vectorH.logsize(arg_z)))
3306        __(blr)
33073:      __(bne cr2,8f)
3308        __(li temp2,-1<<fixnum_shift)
3309        __(mr temp0,arg_z)      /* fast pointer */
3310        __(mr temp1,arg_z)      /* slow pointer */
33114:      __(extract_lisptag(imm0,temp0))
3312        __(cmpri(cr7,temp0,nil_value))
3313        __(cmpri(cr1,imm0,tag_list))
3314        __(addi temp2,temp2,fixnum_one)
3315        __(beq cr7,9f)
3316        __(andi. imm0,temp2,1<<fixnum_shift)
3317        __(bne cr1,8f)
3318        __(extract_lisptag(imm1,temp1))
3319        __(_cdr(temp0,temp0))
3320        __(cmpri(cr1,imm1,tag_list))
3321        __(beq cr0,4b)
3322        __(bne cr1,8f)
3323        __(_cdr(temp1,temp1))
3324        __(cmpr(cr0,temp0,temp1))
3325        __(bne cr0,4b)
33268:     
3327        __(jump_builtin(_builtin_length,1))
33289:     
3329        __(mr arg_z,temp2)
3330        __(blr)
3331
3332_spentry(builtin_seqtype)
3333        __(extract_typecode(imm0,arg_z))
3334        __(cmpri(cr0,imm0,tag_list))
3335        __(cmpri(cr1,imm1,min_vector_subtag))
3336        __(beq cr0,1f)
3337        __(blt- cr1,2f)
3338        __(li arg_z,nil_value)
3339        __(blr)
33401:      __(li arg_z,t_value)
3341        __(blr)
33422:
3343        __(jump_builtin(_builtin_seqtype,1))
3344       
3345_spentry(builtin_assq)
3346        __(cmpri(arg_z,nil_value))
3347        __(beqlr)
33481:      __(trap_unless_list(arg_z,imm0))
3349        __(_car(arg_x,arg_z))
3350        __(_cdr(arg_z,arg_z))
3351        __(cmpri(cr2,arg_x,nil_value))
3352        __(cmpri(cr1,arg_z,nil_value))
3353        __(beq cr2,2f)
3354        __(trap_unless_list(arg_x,imm0))
3355        __(_car(temp0,arg_x))
3356        __(cmpr(temp0,arg_y))
3357        __(bne cr0,2f)
3358        __(mr arg_z,arg_x)
3359        __(blr)
33602:      __(bne cr1,1b)
3361        __(blr)
3362
3363
3364
3365_spentry(builtin_memq)
3366        __(cmpri(cr1,arg_z,nil_value))
3367        __(b 2f)
33681:      __(trap_unless_list(arg_z,imm0))
3369        __(_car(arg_x,arg_z))
3370        __(_cdr(temp0,arg_z))
3371        __(cmpr(arg_x,arg_y))
3372        __(cmpri(cr1,temp0,nil_value))
3373        __(beqlr)
3374        __(mr arg_z,temp0)
33752:      __(bne cr1,1b)
3376        __(blr)
3377
3378
3379_spentry(builtin_logbitp)
3380        /* Call out unless both fixnums,0 <=  arg_y < 30 */
3381        __(cmplri(cr2,arg_y,30<<fixnum_shift))
3382        __(extract_lisptag(imm0,arg_y))
3383        __(extract_lisptag(imm1,arg_z))
3384        __(cmpri(cr0,imm0,tag_fixnum))
3385        __(cmpri(cr1,imm1,tag_fixnum))
3386        __(unbox_fixnum(imm0,arg_y))
3387        __(subfic imm0,imm0,30)
3388        __(rlwnm imm0,arg_z,imm0,31,31)
3389        __(rlwimi imm0,imm0,4,27,27)
3390        __(bnl cr2,1f)
3391        __(bne cr0,1f)
3392        __(bne cr1,1f)
3393        __(addi arg_z,imm0,nil_value)
3394        __(blr)
33951:
3396        __(jump_builtin(_builtin_logbitp,2))
3397
3398_spentry(builtin_logior)
3399        __(extract_lisptag(imm0,arg_y))
3400        __(extract_lisptag(imm1,arg_z))
3401        __(cmpri(cr0,imm0,tag_fixnum))
3402        __(cmpri(cr1,imm1,tag_fixnum))
3403        __(bne- cr0,1f)
3404        __(bne- cr1,1f)
3405        __(or arg_z,arg_y,arg_z)
3406        __(blr)
34071:
3408        __(jump_builtin(_builtin_logior,2))
3409
3410_spentry(builtin_logand)
3411        __(extract_lisptag(imm0,arg_y))
3412        __(extract_lisptag(imm1,arg_z))
3413        __(cmpri(cr0,imm0,tag_fixnum))
3414        __(cmpri(cr1,imm1,tag_fixnum))
3415        __(bne- cr0,1f)
3416        __(bne- cr1,1f)
3417        __(and arg_z,arg_y,arg_z)
3418        __(blr)
34191:
3420        __(jump_builtin(_builtin_logand,2))
3421       
3422_spentry(builtin_ash)
3423        __(cmpri(cr1,arg_z,0))
3424        __(extract_lisptag(imm0,arg_y))
3425        __(extract_lisptag(imm1,arg_z))
3426        __(cmpri(cr0,imm0,tag_fixnum))
3427        __(cmpri(cr3,imm1,tag_fixnum))
3428        __(cmpri(cr2,arg_z,-(29<<2)))   /* !! 2 =  fixnumshift */
3429        __(bne- cr0,9f)
3430        __(bne- cr3,9f)
3431        __(bne cr1,0f)
3432        __(mr arg_z,arg_y)      /* (ash n 0) => n */
3433        __(blr)
34340:             
3435        __(unbox_fixnum(imm1,arg_y))
3436        __(unbox_fixnum(imm0,arg_z))
3437        __(bgt cr1,2f)
3438        /* (ash n -count) => fixnum */
3439        __(neg imm2,imm0)
3440        __(bgt cr2,1f)
3441        __(li imm2,31)
34421:     
3443        __(sraw imm0,imm1,imm2)
3444        __(box_fixnum(arg_z,imm0))
3445        __(blr)
3446        /* Integer-length of arg_y/imm1 to imm2 */
34472:             
3448        __(cntlzw. imm2,imm1)
3449        __(bne 3f)              /* cr0[eq] set if negative */
3450        __(not imm2,imm1)
3451        __(cntlzw imm2,imm2)
34523:
3453        __(subfic imm2,imm2,32)
3454        __(add imm2,imm2,imm0)   /* imm2 <- integer-length(imm1) + count */
3455        __(cmpri(cr1,imm2,31-fixnumshift))
3456        __(cmpri(cr2,imm0,32))
3457        __(slw imm2,imm1,imm0)
3458        __(bgt cr1,6f)
3459        __(box_fixnum(arg_z,imm2))
3460        __(blr)
34616:
3462        __(bgt cr2,9f)
3463        __(bne cr2,7f)
3464        /* Shift left by 32 bits exactly */
3465        __(mr imm0,imm1)
3466        __(li imm1,0)
3467        __(beq _SPmakes64)
3468        __(b _SPmakeu64)
34697:
3470        /* Shift left by fewer than 32 bits, result not a fixnum */
3471        __(subfic imm0,imm0,32)
3472        __(beq 8f)
3473        __(srw imm0,imm1,imm0)
3474        __(mr imm1,imm2)
3475        __(b _SPmakeu64)
34768:     
3477        __(sraw imm0,imm1,imm0)
3478        __(mr imm1,imm2)
3479        __(b _SPmakes64)       
34809:             
3481        __(jump_builtin(_builtin_ash,2))
3482
3483_spentry(builtin_negate)
3484        __(extract_lisptag_(imm0,arg_z))
3485        __(bne- cr0,1f)
3486        __(nego. arg_z,arg_z)
3487        __(bnslr+)
3488        __(mtxer rzero)
3489        __(unbox_fixnum(imm1,arg_z))
3490        __(xoris imm1,imm1,0xc000)
3491        __(li imm0,one_digit_bignum_header)
3492        __(Misc_Alloc_Fixed(arg_z,imm0,8))
3493        __(str(imm1,misc_data_offset(arg_z)))
3494        __(blr)
34951:
3496        __(jump_builtin(_builtin_negate,1))
3497
3498_spentry(builtin_logxor)
3499        __(extract_lisptag(imm0,arg_y))
3500        __(extract_lisptag(imm1,arg_z))
3501        __(cmpri(cr0,imm0,tag_fixnum))
3502        __(cmpri(cr1,imm1,tag_fixnum))
3503        __(bne- cr0,1f)
3504        __(bne- cr1,1f)
3505        __(xor arg_z,arg_y,arg_z)
3506        __(blr)
35071:
3508        __(jump_builtin(_builtin_logxor,2))
3509
3510
3511_spentry(builtin_aref1)
3512        .globl _SPsubtag_misc_ref
3513        __(extract_typecode(imm0,arg_y))
3514        __(cmpri(cr0,imm0,min_vector_subtag))
3515        __(box_fixnum(arg_x,imm0))
3516        __(bgt cr0,1f)
3517        __(jump_builtin(_builtin_aref1,2))
35181:
3519        __(b _SPsubtag_misc_ref)
3520
3521_spentry(builtin_aset1)
3522        __(extract_typecode(imm0,arg_x))
3523        __(cmpri(cr0,imm0,min_vector_subtag))
3524        __(box_fixnum(temp0,imm0))
3525        __(bgt cr0,1f)
3526        __(jump_builtin(_builtin_aset1,3))
35271:
3528        __(b _SPsubtag_misc_set)
3529
3530/* Enter the debugger */
3531_spentry(breakpoint)
3532        __(li r3,0)
3533        __(tw 28,sp,sp) /* 28 = lt|gt|eq (assembler bug for the latter) */
3534        __(blr)         /* if handler didn't */
3535
3536/*
3537        We're entered with an eabi_c_frame on the C stack.  There's a
3538        lisp_frame reserved underneath it; we'll link it in in a minute.
3539        Load the outgoing GPR arguments from eabi_c_frame.param[0-7],
3540        then shrink the eabi_c_frame.
3541*/
3542       
3543_spentry(eabi_ff_call)
3544        __(mflr loc_pc)
3545        __(str(sp,eabi_c_frame.savelr(sp)))
3546        __(vpush_saveregs())            /* Now we can use save0-save7 to point to stacks */
3547        __(mr save0,rcontext)   /* or address globals. */
3548        __(extract_typecode(imm0,arg_z))
3549        __(cmpri(imm0,subtag_macptr))
3550        __(ldr(save1,0(sp)))    /* bottom of reserved lisp frame */
3551        __(la save2,-lisp_frame.size(save1))    /* top of lisp frame*/
3552        __(zero_doublewords save2,0,lisp_frame.size)
3553        __(str(save1,lisp_frame.backlink(save2)))
3554        __(str(save2,c_frame.backlink(sp)))
3555        __(str(fn,lisp_frame.savefn(save2)))
3556        __(str(loc_pc,lisp_frame.savelr(save2)))
3557        __(str(vsp,lisp_frame.savevsp(save2)))
3558        __(bne 1f)
3559        __(ldr(arg_z,macptr.address(arg_z)))
35601:
3561        __(ldr(save3,tcr.cs_area(rcontext)))
3562        __(str(save2,area.active(save3)))
3563        __(str(allocptr,tcr.save_allocptr(rcontext)))
3564        __(str(allocbase,tcr.save_allocbase(rcontext)))
3565        __(str(tsp,tcr.save_tsp(rcontext)))
3566        __(str(vsp,tcr.save_vsp(rcontext)))
3567        __(mtctr arg_z)
3568        __(str(rzero,tcr.ffi_exception(rcontext)))
3569        __(mffs f0)
3570        __(stfd f0,tcr.lisp_fpscr(rcontext))    /* remember lisp's fpscr */
3571        __(mtfsf 0xff,fp_zero)  /* zero foreign fpscr */
3572        __(li imm1,TCR_STATE_FOREIGN)
3573        __(str(imm1,tcr.valence(rcontext)))
3574        __(ldr(r2,tcr.native_thread_info(rcontext)))
3575        __(ldr(r13,lisp_globals.saveR13(0)))
3576        __(ldr(r3,eabi_c_frame.param0(sp)))
3577        __(ldr(r4,eabi_c_frame.param1(sp)))
3578        __(ldr(r5,eabi_c_frame.param2(sp)))
3579        __(ldr(r6,eabi_c_frame.param3(sp)))
3580        __(ldr(r7,eabi_c_frame.param4(sp)))
3581        __(ldr(r8,eabi_c_frame.param5(sp)))
3582        __(ldr(r9,eabi_c_frame.param6(sp)))
3583        __(ldr(r10,eabi_c_frame.param7(sp)))
3584        __(la save1,eabi_c_frame.minsiz-eabi_c_frame.param0(sp))
3585        __(str(rzero,eabi_c_frame.savelr(save1)))
3586        __(str(save2,eabi_c_frame.backlink(save1)))
3587        __(mr sp,save1)
3588        /* If we're calling a varargs C function, it'll want to
3589        know whether or not we've passed any args in FP regs.
3590        Better to say that we did (and force callee to save FP
3591        arg regs on entry) than to say that we didn't and get
3592        garbage results */
3593        __(crset 6)
3594        __(bctrl)
3595_local_label(FF_call_return_common):
3596        /* C should have preserved save0 (= rcontext) for us. */
3597        __(ldr(sp,0(sp)))
3598        __(mr imm2,save0)
3599        __(ldr(vsp,lisp_frame.savevsp(sp)))
3600        __(vpop_saveregs())
3601        __(li rzero,0)
3602        __(mr loc_pc,rzero)
3603        __(li arg_x,nil_value)
3604        __(li arg_y,nil_value)
3605        __(li arg_z,nil_value)
3606        __(li temp0,nil_value)
3607        __(li temp1,nil_value)
3608        __(li temp2,nil_value)
3609        __(li temp3,nil_value)
3610        __(li temp4,nil_value)
3611        __(li fn,nil_value)
3612        __(mr rcontext,imm2)
3613        __(li imm2,TCR_STATE_LISP)
3614        __(str(imm2,tcr.valence(rcontext)))     
3615        __(ldr(allocptr,tcr.save_allocptr(rcontext)))
3616        __(ldr(allocbase,tcr.save_allocbase(rcontext)))
3617        __(ldr(tsp,tcr.save_tsp(rcontext)))
3618        __(ldr(loc_pc,lisp_frame.savelr(sp)))
3619        __(mtlr loc_pc)
3620        __(ldr(fn,lisp_frame.savefn(sp)))
3621        __(mffs f0)
3622        __(stfd f0,8(sp))
3623        __(lwz imm3,12(sp))     /* imm3 = FPSCR after call */
3624        __(clrrwi imm2,imm3,8)
3625        __(discard_lisp_frame())
3626        __(str(imm2,tcr.ffi_exception(rcontext)))
3627        __(lfd f0,tcr.lisp_fpscr(rcontext))
3628        __(mtfsf 0xff,f0)
3629        __(check_pending_interrupt([cr1]))
3630        __(blr)
3631       
3632/*
3633        This gets called with R11 holding the unboxed callback index.
3634*/
3635_spentry(eabi_callback)
3636        /* First, we extend the C frame so that it has room for
3637        incoming arg regs. */
3638        __(ldr(r0,eabi_c_frame.backlink(sp)))
3639        __(stru(r0,eabi_c_frame.param0-varargs_eabi_c_frame.incoming_stack_args(sp)))
3640        __(mflr r0)
3641        __(str(r0,varargs_eabi_c_frame.savelr(sp)))
3642        __(str(r3,varargs_eabi_c_frame.gp_save+(0*4)(sp)))
3643        __(str(r4,varargs_eabi_c_frame.gp_save+(1*4)(sp)))
3644        __(str(r5,varargs_eabi_c_frame.gp_save+(2*4)(sp)))
3645        __(str(r6,varargs_eabi_c_frame.gp_save+(3*4)(sp)))
3646        __(str(r7,varargs_eabi_c_frame.gp_save+(4*4)(sp)))
3647        __(str(r8,varargs_eabi_c_frame.gp_save+(5*4)(sp)))
3648        __(str(r9,varargs_eabi_c_frame.gp_save+(6*4)(sp)))
3649        __(str(r10,varargs_eabi_c_frame.gp_save+(7*4)(sp)))
3650        /* Could check the appropriate CR bit and skip saving FP regs here */
3651        __(stfd f1,varargs_eabi_c_frame.fp_save+(0*8)(sp))
3652        __(stfd f2,varargs_eabi_c_frame.fp_save+(1*8)(sp))
3653        __(stfd f3,varargs_eabi_c_frame.fp_save+(2*8)(sp))
3654        __(stfd f4,varargs_eabi_c_frame.fp_save+(3*8)(sp))
3655        __(stfd f5,varargs_eabi_c_frame.fp_save+(4*8)(sp))
3656        __(stfd f6,varargs_eabi_c_frame.fp_save+(5*8)(sp))
3657        __(stfd f7,varargs_eabi_c_frame.fp_save+(6*8)(sp))
3658        __(stfd f8,varargs_eabi_c_frame.fp_save+(7*8)(sp))
3659        __(la r0,varargs_eabi_c_frame.incoming_stack_args(sp))
3660        __(str(r0,varargs_eabi_c_frame.overflow_arg_area(sp)))
3661        __(la r0,varargs_eabi_c_frame.regsave(sp))
3662        __(str(r0,varargs_eabi_c_frame.reg_save_area(sp)))
3663        __(li r0,0)
3664        __(str(r0,varargs_eabi_c_frame.flags(sp)))
3665
3666        /* Save the non-volatile registers on the sp stack */
3667        /* This is a non-standard stack frame, but noone will ever see it, */
3668        /* so it doesn't matter. It will look like more of the stack frame pushed below. */
3669        __(stru(sp,-(c_reg_save.size)(sp)))
3670        __(stmw r13,c_reg_save.save_gprs(sp))
3671        __(mffs f0)
3672        __(stfd f0,c_reg_save.save_fp_zero(sp))
3673        __(ldr(r31,c_reg_save.save_fp_zero+4(sp)))      /* recover FPSCR image */
3674        __(str(r31,c_reg_save.save_fpscr(sp)))
3675        __(lwi(r30,0x43300000))
3676        __(lwi(r31,0x80000000))
3677        __(str(r30,c_reg_save.save_fp_zero(sp)))
3678        __(str(r31,c_reg_save.save_fp_zero+4(sp)))
3679        __(stfd fp_s32conv,c_reg_save.save_fps32conv(sp))
3680        __(lfd fp_s32conv,c_reg_save.save_fp_zero(sp))
3681        __(stfd fp_zero,c_reg_save.save_fp_zero(sp))
3682        __(lfs fp_zero,lisp_globals.short_float_zero(0))        /* ensure that fp_zero contains 0.0 */
3683
3684       
3685/* Restore rest of Lisp context. */
3686/* Could spread out the memory references here to gain a little speed */
3687        __(li loc_pc,0)
3688        __(li fn,0)                     /* subprim, not a lisp function */
3689        __(li temp4,0)
3690        __(li temp3,0)
3691        __(li temp2,0)
3692        __(li temp1,0)
3693        __(li temp0,0)
3694        __(li arg_x,0)
3695        __(box_fixnum(arg_y,r11))       /* callback-index */
3696        __(la arg_z,c_reg_save.size+varargs_eabi_c_frame.gp_save(sp))   /* parameters (tagged as a fixnum) */
3697
3698        /* Recover lisp thread context. Have to call C code to do so. */
3699        __(ref_global(r12,get_tcr))
3700        __(mtctr r12)
3701        __(li r3,1)
3702        __(stru(sp,-(stack_align(eabi_c_frame.minsiz))(sp)))
3703        __(bctrl)
3704        __(la sp,(stack_align(eabi_c_frame.minsiz))(sp))
3705        __(mr rcontext,r3)
3706        __(li allocptr,0)
3707        __(li allocbase,0)
3708        __(ldr(vsp,tcr.save_vsp(rcontext)))
3709        __(ldr(tsp,tcr.save_tsp(rcontext)))             
3710        __(li rzero,0)
3711        __(mtxer rzero) /* lisp wants the overflow bit clear */
3712        __(li imm0,TCR_STATE_LISP)
3713        __(li save0,0)
3714        __(li save1,0)
3715        __(li save2,0)
3716        __(li save3,0)
3717        __(li save4,0)
3718        __(li save5,0)
3719        __(li save6,0)
3720        __(li save7,0)
3721        __(str(imm0,tcr.valence(rcontext)))
3722        __(ldr(allocptr,tcr.save_allocptr(rcontext)))
3723        __(ldr(allocbase,tcr.save_allocbase(rcontext)))
3724        __(lfd f0,tcr.lisp_fpscr(rcontext))
3725        __(mtfsf 0xff,f0)
3726
3727        /* load nargs and callback to the lisp */
3728        __(set_nargs(2))
3729        __(ldr(imm2,tcr.cs_area(rcontext)))
3730        __(ldr(imm4,area.active(imm2)))
3731        __(stru(imm4,-lisp_frame.size(sp)))
3732        __(str(imm3,lisp_frame.savelr(sp)))
3733        __(str(vsp,lisp_frame.savevsp(sp)))     /* for stack overflow code */
3734        __(li fname,nrs.callbacks)      /* %pascal-functions% */
3735        __(call_fname)
3736        __(ldr(imm2,lisp_frame.backlink(sp)))
3737        __(ldr(imm3,tcr.cs_area(rcontext)))
3738        __(str(imm2,area.active(imm3)))
3739        __(discard_lisp_frame())
3740        /* save_vsp will be restored from ff_call's stack frame, but */
3741        /* I included it here for consistency. */
3742        /* save_tsp is set below after we exit Lisp context. */
3743        __(str(allocptr,tcr.save_allocptr(rcontext)))
3744        __(str(allocbase,tcr.save_allocbase(rcontext)))
3745        __(str(vsp,tcr.save_vsp(rcontext)))
3746        __(str(tsp,tcr.save_tsp(rcontext)))
3747        /* Exit lisp context */
3748        /* This is not necessary yet, but will be once we can be interrupted */
3749        __(li imm1,TCR_STATE_FOREIGN)
3750        __(str(imm1,tcr.valence(rcontext)))
3751        /* Restore the non-volatile registers & fpscr */
3752        __(lfd fp_zero,c_reg_save.save_fp_zero(sp))
3753        __(ldr(r31,c_reg_save.save_fpscr(sp)))
3754        __(str(r31,c_reg_save.save_fp_zero+4(sp)))
3755        __(lfd f0,c_reg_save.save_fp_zero(sp))
3756        __(mtfsf 0xff,f0)
3757        __(lmw r13,c_reg_save.save_gprs(sp))
3758        __(lfd fp_s32conv,c_reg_save.save_fps32conv(sp))
3759        __(ldr(sp,0(sp)))
3760
3761        __(ldr(r3,varargs_eabi_c_frame.gp_save+(0*4)(sp)))
3762        __(ldr(r4,varargs_eabi_c_frame.gp_save+(1*4)(sp)))
3763        __(lfd f1,varargs_eabi_c_frame.fp_save+(8*8)(sp))
3764        __(ldr(r5,varargs_eabi_c_frame.savelr(sp)))
3765        __(str(r5,varargs_eabi_c_frame.old_savelr(sp)))
3766        __(mtlr r5)
3767        __(ldr(r5,varargs_eabi_c_frame.backlink(sp)))
3768        __(str(r5,varargs_eabi_c_frame.old_backlink(sp)))
3769        __(la sp,varargs_eabi_c_frame.old_backlink(sp))
3770        __(ldr(r2,tcr.native_thread_info(rcontext)))
3771        __(blr)
3772       
3773/*
3774        Do a linux system call:  the system call index is (boxed)
3775        in arg_z, and other arguments are in an eabi_c_frame on
3776        the C stack.  As is the case with an eabi_ff_call, there's
3777        a lisp frame reserved underneath the eabi_c_frame.
3778
3779        This is a little simpler than eabi_ff_call, because we
3780        can assume that there are no synchronous callbacks to
3781        lisp (that might cause a GC.)  It's also simpler for the
3782        caller, since we return error status atomically.
3783
3784        A system call can clobber any or all of r9-r12, so we need
3785        to save and restore allocptr, allocbase, and tsp.
3786        */
3787_spentry(syscall)
3788/*
3789        We're entered with an eabi_c_frame on the C stack.  There's a
3790        lisp_frame reserved underneath it; we'll link it in in a minute.
3791        Load the outgoing GPR arguments from eabi_c_frame.param[0-7],
3792        then shrink the eabi_c_frame.
3793*/
3794        __(mflr loc_pc)
3795        __(str(sp,eabi_c_frame.savelr(sp)))
3796        __(li arg_x,nil_value)
3797        __(mr temp0,rcontext)
3798        __(ldr(temp1,c_frame.backlink(sp)))     /* bottom of reserved lisp frame */
3799        __(la temp2,-lisp_frame.size(temp1))    /* top of lisp frame */
3800        __(zero_doublewords temp2,0,lisp_frame.size)
3801        __(str(temp1,lisp_frame.backlink(temp2)))
3802        __(str(temp2,c_frame.backlink(sp)))
3803        __(str(fn,lisp_frame.savefn(temp2)))
3804        __(str(loc_pc,lisp_frame.savelr(temp2)))
3805        __(str(vsp,lisp_frame.savevsp(temp2)))
3806        __(ldr(temp3,tcr.cs_area(rcontext)))
3807        __(str(temp2,area.active(temp3)))
3808        __(str(allocptr,tcr.save_allocptr(rcontext)))
3809        __(str(allocbase,tcr.save_allocbase(rcontext)))
3810        __(str(tsp,tcr.save_tsp(rcontext)))
3811        __(str(vsp,tcr.save_vsp(rcontext)))
3812        __(str(rzero,tcr.ffi_exception(rcontext)))
3813        __(li imm1,TCR_STATE_FOREIGN)
3814        __(str(imm1,tcr.valence(rcontext)))
3815        __(ldr(r13,lisp_globals.saveR13(0)))
3816        __(ldr(r3,eabi_c_frame.param0(sp)))
3817        __(ldr(r4,eabi_c_frame.param1(sp)))
3818        __(ldr(r5,eabi_c_frame.param2(sp)))
3819        __(ldr(r6,eabi_c_frame.param3(sp)))
3820        __(ldr(r7,eabi_c_frame.param4(sp)))
3821        __(ldr(r8,eabi_c_frame.param5(sp)))
3822        __(ldr(r9,eabi_c_frame.param6(sp)))
3823        __(ldr(r10,eabi_c_frame.param7(sp)))
3824        __(la temp1,eabi_c_frame.minsiz-eabi_c_frame.param0(sp))
3825        __(str(rzero,eabi_c_frame.savelr(temp1)))
3826        __(str(temp2,eabi_c_frame.backlink(temp1)))
3827        __(mr sp,temp1)
3828        __(unbox_fixnum(r0,arg_z))
3829        __(sc)
3830        __(nop)
3831        /* C should have preserved temp0 (= rcontext) for us. */
3832        __(ldr(sp,0(sp)))
3833        __(mr imm2,temp0)
3834        __(ldr(vsp,lisp_frame.savevsp(sp)))
3835        __(li rzero,0)
3836        __(mr loc_pc,rzero)
3837        __(mr fn,rzero)
3838        __(li arg_x,nil_value)
3839        __(li arg_y,nil_value)
3840        __(li arg_z,nil_value)
3841        __(li temp0,nil_value)
3842        __(li temp1,nil_value)
3843        __(li temp2,nil_value)
3844        __(li temp3,nil_value)
3845        __(li temp4,nil_value)
3846        __(li fn,nil_value)
3847        __(li imm3,TCR_STATE_LISP)
3848        __(mr rcontext,imm2)
3849        __(stw imm3,tcr.valence(rcontext))
3850        __(ldr(allocptr,tcr.save_allocptr(rcontext)))
3851        __(ldr(allocbase,tcr.save_allocbase(rcontext)))
3852        __(ldr(tsp,tcr.save_tsp(rcontext)))
3853        __(ldr(loc_pc,lisp_frame.savelr(sp)))
3854        __(mtlr loc_pc)
3855        __(ldr(fn,lisp_frame.savefn(sp)))
3856        __(discard_lisp_frame())
3857        __(check_pending_interrupt([cr1]))
3858        __(bnslr)
3859        __(neg r3,r3)
3860        __(mtxer rzero)
3861        __(blr)
3862       
3863/* arg_z should be of type (UNSIGNED-BYTE 64); return high 32 bits
3864        in imm0, low 32 bits in imm1 */
3865
3866_spentry(getu64)
3867        __(extract_typecode(imm0,arg_z))
3868        __(cmpri(cr0,imm0,tag_fixnum))
3869        __(cmpri(cr1,arg_z,0))
3870        __(cmpri(cr2,imm0,subtag_bignum))
3871        __(unbox_fixnum(imm1,arg_z))
3872        __(bne cr0,8f)
3873        __(bgelr cr1)
38749:
3875        __(uuo_interr(error_object_not_u64,arg_z))
38768:
3877        __(bne- cr2,9b)
3878        __(getvheader(imm2,arg_z))
3879        __(cmpri(cr2,imm2,two_digit_bignum_header))
3880        __(vrefr(imm1,arg_z,0))
3881        __(cmpri(cr1,imm1,0))
3882        __(li imm0,0)
3883        __(bge cr2,2f)
3884        __(blt- cr1,9b)
3885        __(blr)
38862:
3887        __(cmpri(cr0,imm2,three_digit_bignum_header))
3888        __(vrefr(imm0,arg_z,1))
3889        __(cmpri(cr1,imm0,0))
3890        __(bne cr2,3f)
3891        __(blt- cr1,9b)
3892        __(blr)
38933:
3894        __(vrefr(imm2,arg_z,2))
3895        __(cmpri(cr1,imm2,0))
3896        __(bne- cr0,9b)
3897        __(bne- cr1,9b)
3898        __(blr)
3899
3900/* arg_z should be of type (SIGNED-BYTE 64); return high 32 bits
3901        in imm0, low 32 bits in imm1 */
3902
3903_spentry(gets64)
3904        __(extract_typecode(imm0,arg_z))
3905        __(cmpri(cr0,imm0,tag_fixnum))
3906        __(cmpri(cr2,imm0,subtag_bignum))
3907        __(unbox_fixnum(imm1,arg_z))
3908        __(srawi imm0,imm1,31)
3909        __(beqlr cr0)
3910        __(bne cr2,9f)
3911        __(getvheader(imm2,arg_z))
3912        __(cmpri(cr2,imm2,two_digit_bignum_header))
3913        __(vrefr(imm1,arg_z,0))
3914        __(srawi imm0,imm1,31)
3915        __(bltlr cr2)
3916        __(vrefr(imm0,arg_z,1))
3917        __(beqlr cr2)
39189:
3919        __(uuo_interr(error_object_not_s64,arg_z))
3920
3921/*
3922  Construct a lisp integer out of the 64-bit unsigned value in
3923  imm0 (high 32 bits) and imm1 (low 32 bits). */
3924_spentry(makeu64)
3925        __(cmpri(cr1,imm0,0))
3926        __(rlwinm. imm2,imm1,0,0,fixnum_shift)
3927        __(li imm2,three_digit_bignum_header)
3928        __(box_fixnum(arg_z,imm1))
3929        __(blt cr1,3f)
3930        __(bne cr1,2f)
3931        __(beqlr cr0) /* A fixnum */
3932        __(blt cr0,2f)
3933        __(li imm2,one_digit_bignum_header)
3934        __(Misc_Alloc_Fixed(arg_z,imm2,8))
3935        __(str(imm1,misc_data_offset(arg_z)))
3936        __(blr)
39372:
3938        __(li imm2,two_digit_bignum_header)
39393:
3940        __(Misc_Alloc_Fixed(arg_z,imm2,16))
3941        __(str(imm1,misc_data_offset(arg_z)))
3942        __(str(imm0,misc_data_offset+4(arg_z)))
3943        __(blr)
3944
3945
3946/*
3947  Construct a lisp integer out of the 64-bit signed value in
3948  imm0 (high 32 bits) and imm1 (low 32 bits). */
3949_spentry(makes64)
3950        __(srawi imm2,imm1,31)
3951        __(cmpr(cr1,imm2,imm0))
3952        __(addo imm2,imm1,imm1)
3953        __(addo. arg_z,imm2,imm2)
3954        __(bne cr1,2f) /* High word is significant */
3955        __(li imm2,one_digit_bignum_header)
3956        __(bnslr cr0) /* No overflow:    fixnum */
3957        __(mtxer rzero)
3958        __(Misc_Alloc_Fixed(arg_z,imm2,8))
3959        __(str(imm1,misc_data_offset(arg_z)))
3960        __(blr)
39612:
3962        __(mtxer rzero)
3963        __(li imm2,two_digit_bignum_header)
3964        __(Misc_Alloc_Fixed(arg_z,imm2,16))
3965        __(str(imm1,misc_data_offset(arg_z)))
3966        __(str(imm0,misc_data_offset+4(arg_z)))
3967        __(blr)
3968
3969_spentry(heap_restv_arg)
3970
3971_spentry(req_heap_restv_arg)
3972
3973_spentry(heap_cons_restv_arg)
3974
3975        /* Restore current thread's interrupt level to arg_z,
3976           noting whether the tcr's interrupt_pending flag was set. */
3977_spentry(restoreintlevel)
3978        __(cmpri(cr1,arg_z,0))
3979        __(ldr(imm0,tcr.interrupt_pending(rcontext)))
3980        __(cmpri(cr0,imm0,0))
3981        __(bne cr1,1f)
3982        __(beq cr0,1f)
3983        __(str(rzero,tcr.interrupt_pending(rcontext)))
3984        __(li nargs,fixnum_one)
3985        __(twgti nargs,0)
3986        __(blr)
39871:     
3988        __(str(arg_z,tcr.interrupt_level(rcontext)))
3989        __(blr)
3990
3991/*
3992  Construct a lisp integer out of the 32-bit signed value in imm0
3993 */
3994_spentry(makes32)
3995        __(addo imm1,imm0,imm0)
3996        __(addo. arg_z,imm1,imm1)
3997        __(bnslr+)
3998        __(mtxer rzero)
3999        __(li imm1,one_digit_bignum_header)
4000        __(Misc_Alloc_Fixed(arg_z,imm1,node_size*2))
4001        __(str(imm0,misc_data_offset(arg_z)))
4002        __(blr)
4003
4004/*
4005  Construct a lisp integer out of the 32-bit unsigned value in imm0
4006 */
4007_spentry(makeu32)
4008        __(clrrwi. imm1,imm0,31-nfixnumtagbits)
4009        __(cmpri(cr1,imm0,0))
4010        __(box_fixnum(arg_z,imm0))
4011        __(beqlr cr0) /* A fixnum */
4012        __(blt cr1,2f)
4013        __(li imm2,one_digit_bignum_header)
4014        __(Misc_Alloc_Fixed(arg_z,imm2,8))
4015        __(str(imm0,misc_data_offset(arg_z)))
4016        __(blr)
40172:
4018        __(li imm2,two_digit_bignum_header)
4019        __(Misc_Alloc_Fixed(arg_z,imm2,16))
4020        __(str(imm0,misc_data_offset(arg_z)))
4021        __(blr)
4022
4023/* 
4024  arg_z should be of type (SIGNED-BYTE 32); return unboxed result in imm0
4025*/
4026_spentry(gets32)
4027        __(extract_typecode(imm1,arg_z))
4028        __(cmpri(cr0,imm1,tag_fixnum))
4029        __(cmpri(cr2,imm1,subtag_bignum))
4030        __(unbox_fixnum(imm0,arg_z))
4031        __(beqlr+ cr0)
4032        __(bne cr2,9f)
4033        __(getvheader(imm1,arg_z))
4034        __(cmpri(cr1,imm1,one_digit_bignum_header))
4035        __(vrefr(imm0,arg_z,0))
4036        __(beqlr+ cr1)
40379:
4038        __(uuo_interr(error_object_not_signed_byte_32,arg_z))
4039
4040/* 
4041  arg_z should be of type (UNSIGNED-BYTE 32); return unboxed result in imm0
4042*/
4043
4044_spentry(getu32)
4045        __(extract_typecode(imm1,arg_z))
4046        __(cmpri(cr0,imm1,tag_fixnum))
4047        __(cmpri(cr1,arg_z,0))
4048        __(cmpri(cr2,imm1,subtag_bignum))
4049        __(unbox_fixnum(imm0,arg_z))
4050        __(bne cr0,8f)
4051        __(bgelr cr1)
40528:
4053        __(bne- cr2,9f)
4054        __(getvheader(imm2,arg_z))
4055        __(cmpri(cr2,imm2,two_digit_bignum_header))
4056        __(vrefr(imm0,arg_z,0))
4057        __(cmpri(cr0,imm0,0))
4058        __(bgt cr2,9f)
4059        __(beq cr2,2f)
4060        __(blt cr0,9f)
4061        __(blr)
40622:
4063        __(vrefr(imm1,arg_z,1))
4064        __(cmpri(cr0,imm1,0))
4065        __(beqlr+ cr0)
4066
40679:
4068        __(uuo_interr(error_object_not_unsigned_byte_32,arg_z))
4069
4070/*
4071  arg_z has overflowed (by one bit) as the result of an addition or subtraction.
4072  Make a bignum out of it.
4073*/
4074_spentry(fix_overflow)
4075        __(mtxer rzero)
4076        __(unbox_fixnum(imm1,arg_z))
4077        __(xoris imm1,imm1,0xc000)
4078        __(li imm0,one_digit_bignum_header)
4079        __(Misc_Alloc_Fixed(arg_z,imm0,8))
4080        __(str(imm1,misc_data_offset(arg_z)))
4081        __(blr)
4082               
4083
4084
4085/*
4086        As per mvpass above, but in this case fname is known to be a
4087        symbol.
4088*/
4089_spentry(mvpasssym)
4090        __(cmpri(cr0,nargs,4*nargregs))
4091        __(mflr loc_pc)
4092        __(mr imm0,vsp)
4093        __(ble+ cr0,1f)
4094         __(subi imm0,imm0,4*nargregs)
4095         __(add imm0,imm0,nargs)
40961:           
4097        __(build_lisp_frame(fn,loc_pc,imm0))
4098        __(ref_global(loc_pc,ret1val_addr))
4099        __(li fn,0)
4100        __(mtlr loc_pc)
4101        __(jump_fname())
4102
4103       
4104/* on entry:  temp0 = svar.  On exit, arg_z = value (possibly unbound_marker),
4105        arg_y = symbol, imm3 = svar.index */
4106_spentry(svar_specref)
4107        __(ldr(imm3,svar.idx(temp0)))
4108        __(ldr(imm0,tcr.tlb_limit(rcontext)))
4109        __(ldr(imm2,tcr.tlb_pointer(rcontext)))
4110        __(ldr(arg_y,svar.symbol(temp0)))
4111        __(cmpr(imm3,imm0))
4112        __(bge 1f)
4113        __(ldrx(arg_z,imm2,imm3))
4114        __(cmpri(arg_z,no_thread_local_binding_marker))
4115        __(bnelr)
41161:      __(ldr(arg_z,symbol.vcell(arg_y)))
4117        __(blr)
4118
4119_spentry(svar_specrefcheck)
4120        __(ldr(imm3,svar.idx(temp0)))
4121        __(ldr(imm0,tcr.tlb_limit(rcontext)))
4122        __(ldr(imm2,tcr.tlb_pointer(rcontext)))
4123        __(ldr(arg_y,svar.symbol(temp0)))
4124        __(cmpr(imm3,imm0))
4125        __(bge 1f)
4126        __(ldrx(arg_z,imm2,imm3))
4127        __(cmpri(arg_z,no_thread_local_binding_marker))
4128        __(bne 2f)
41291:      __(ldr(arg_z,symbol.vcell(arg_y)))
41302:      __(treqi(arg_z,unbound_marker))
4131        __(blr)
4132
4133/* This never affects the symbol's vcell */
4134_spentry(svar_bind)
41350:             
4136        __(ldr(imm3,svar.idx(temp0)))
4137        __(ldr(imm0,tcr.tlb_limit(rcontext)))
4138        __(cmpri(imm3,0))
4139        __(trlle(imm0,imm3))           /* tlb too small */
4140        __(ldr(imm2,tcr.tlb_pointer(rcontext)))
4141        __(ldr(imm1,tcr.db_link(rcontext)))
4142        __(ldrx(temp1,imm2,imm3))
4143        __(beq 9f)
4144        __(vpush(temp1))
4145        __(vpush(imm3))
4146        __(vpush(imm1))
4147        __(strx(arg_z,imm2,imm3))
4148        __(str(vsp,tcr.db_link(rcontext)))
4149        __(blr)
41509:
4151        __(ldr(arg_z,svar.symbol(temp0)))
4152        __(lwi(arg_y,XSYMNOBIND))
4153        __(set_nargs(2))
4154        __(b _SPksignalerr)
4155
4156_spentry(svar_bind_self)
41570:             
4158        __(ldr(imm3,svar.idx(temp0)))
4159        __(ldr(imm0,tcr.tlb_limit(rcontext)))
4160        __(cmpri(imm3,0))
4161        __(trlle(imm0,imm3))           /* tlb too small */
4162        __(ldr(imm2,tcr.tlb_pointer(rcontext)))
4163        __(ldr(imm1,tcr.db_link(rcontext)))
4164        __(ldrx(temp1,imm2,imm3))
4165        __(cmpri(cr1,temp1,no_thread_local_binding_marker))
4166        __(ldr(arg_y,svar.symbol(temp0)))
4167        __(beq 9f)
4168        __(mr arg_z,temp1)
4169        __(bne cr1,1f)
4170        __(ldr(arg_z,symbol.vcell(arg_y)))
41711:             
4172        __(vpush(temp1))
4173        __(vpush(imm3))
4174        __(vpush(imm1))
4175        __(strx(arg_z,imm2,imm3))
4176        __(str(vsp,tcr.db_link(rcontext)))
4177        __(blr)
41789:      __(ldr(arg_z,svar.symbol(temp0)))
4179        __(lwi(arg_y,XSYMNOBIND))
4180        __(set_nargs(2))
4181        __(b _SPksignalerr)
4182
4183_spentry(svar_bind_nil)
41840:             
4185        __(ldr(imm3,svar.idx(temp0)))
4186        __(ldr(imm0,tcr.tlb_limit(rcontext)))
4187        __(cmpri(imm3,0))
4188        __(beq- 9f)
4189        __(trlle(imm0,imm3))           /* tlb too small */
4190        __(ldr(imm2,tcr.tlb_pointer(rcontext)))
4191        __(ldrx(temp1,imm2,imm3))
4192        __(ldr(imm1,tcr.db_link(rcontext)))
4193        __(li imm0,nil_value)
4194        __(vpush(temp1))
4195        __(vpush(imm3))
4196        __(vpush(imm1))
4197        __(strx(imm0,imm2,imm3))
4198        __(str(vsp,tcr.db_link(rcontext)))
4199        __(blr)
42009:      __(ldr(arg_z,svar.symbol(temp0)))
4201        __(lwi(arg_y,XSYMNOBIND))
4202        __(set_nargs(2))
4203        __(b _SPksignalerr)
4204                       
4205_spentry(svar_bind_self_boundp_check)
4206        __(ldr(imm3,svar.idx(temp0)))
4207        __(ldr(imm0,tcr.tlb_limit(rcontext)))
4208        __(cmpri(imm3,0))
4209        __(trlle(imm0,imm3))           /* tlb too small */
4210        __(ldr(imm2,tcr.tlb_pointer(rcontext)))
4211        __(ldrx(temp1,imm2,imm3))
4212        __(ldr(imm1,tcr.db_link(rcontext)))
4213        __(beq 9f)              /* no real tlb index */
4214        __(cmpri(temp1,no_thread_local_binding_marker))
4215        __(mr arg_z,temp1)
4216        __(bne 1f)
4217        __(ldr(arg_y,svar.symbol(temp0)))
4218        __(ldr(arg_z,symbol.vcell(arg_y)))
42191:      __(treqi(arg_z,unbound_marker))       
4220        __(vpush(temp1))
4221        __(vpush(imm3))
4222        __(vpush(imm1))
4223        __(strx(arg_z,imm2,imm3))
4224        __(str(vsp,tcr.db_link(rcontext)))
4225        __(blr)
42269:      __(ldr(arg_z,svar.symbol(temp0)))
4227        __(lwi(arg_y,XSYMNOBIND))
4228        __(set_nargs(2))
4229        __(b _SPksignalerr)
4230
4231_spentry(svar_unbind)
4232        __(ldr(imm1,tcr.db_link(rcontext)))
4233        __(ldr(imm2,tcr.tlb_pointer(rcontext)))   
4234        __(ldr(imm3,binding.sym(imm1)))
4235        __(ldr(temp1,binding.val(imm1)))
4236        __(ldr(imm1,binding.link(imm1)))
4237        __(strx(temp1,imm2,imm3))
4238        __(str(imm1,tcr.db_link(rcontext)))
4239        __(blr)
4240
4241_spentry(svar_unbind_n)
4242        __(ldr(imm1,tcr.db_link(rcontext)))
4243        __(ldr(imm2,tcr.tlb_pointer(rcontext)))   
42441:      __(subi imm0,imm0,1)
4245        __(ldr(imm3,binding.sym(imm1)))
4246        __(ldr(temp1,binding.val(imm1)))
4247        __(cmpri(imm0,0))
4248        __(ldr(imm1,binding.link(imm1)))
4249        __(strx(temp1,imm2,imm3))
4250        __(bne 1b)
4251        __(str(imm1,tcr.db_link(rcontext)))
4252        __(blr)
4253
4254 /*
4255   Clobbers imm1,imm2,imm5,arg_x, arg_y
4256*/
4257_spentry(svar_unbind_to)
4258        __(ldr(imm1,tcr.db_link(rcontext)))
4259        __(ldr(imm2,tcr.tlb_pointer(rcontext)))
42601:      __(ldr(imm5,binding.sym(imm1)))
4261        __(ldr(arg_y,binding.val(imm1)))
4262        __(ldr(imm1,binding.link(imm1)))
4263        __(cmpr(imm0,imm1))
4264        __(strx(arg_y,imm2,imm5))
4265        __(bne 1b)
4266        __(str(imm1,tcr.db_link(rcontext)))
4267        __(blr)
4268       
4269/* temp0 = svar for special symbol, arg_z = new value. */       
4270_spentry(svar_specset)
4271        __(ldr(imm3,svar.idx(temp0)))
4272        __(ldr(imm0,tcr.tlb_limit(rcontext)))
4273        __(ldr(imm2,tcr.tlb_pointer(rcontext)))
4274        __(ldr(arg_y,svar.symbol(temp0)))
4275        __(cmpr(imm3,imm0))
4276        __(bge 1f)
4277        __(ldrx(temp1,imm2,imm3))
4278        __(cmpri(temp1,no_thread_local_binding_marker))
4279        __(beq 1f)
4280        __(strx(arg_z,imm2,imm3))
4281        __(blr)
42821:      __(str(arg_z,symbol.vcell(arg_y)))
4283        __(blr)
4284
4285
4286_spentry(svar_setqsym)
4287        __(ldr(arg_y,svar.symbol(temp0)))
4288        __(ldr(imm0,symbol.flags(arg_y)))
4289        __(andi. imm0,imm0,sym_vbit_const_mask)
4290        __(beq _SPsvar_specset)
4291        __(mr arg_z,arg_y)
4292        __(lwi(arg_y,XCONST))
4293        __(set_nargs(2))
4294        __(b _SPksignalerr)
4295
4296_spentry(svar_progvsave)
4297        /* Error if arg_z isn't a proper list.  That's unlikely,
4298           but it's better to check now than to crash later.
4299        */
4300        __(cmpri(arg_z,nil_value))
4301        __(mr temp4,arg_z)      /* fast */
4302        __(mr temp1,arg_z)      /* slow */
4303        __(beq 9f)              /* Null list is proper */
43040:     
4305        __(trap_unless_list(temp4,imm0))
4306        __(_cdr(temp2,temp4))   /* (null (cdr fast)) ? */
4307        __(cmpri(temp2,nil_value))
4308        __(trap_unless_list(temp2,imm0))
4309        __(_cdr(temp4,temp2))
4310        __(beq 9f)
4311        __(_cdr(temp1,temp1))
4312        __(cmpr(temp4,temp1))
4313        __(bne 0b)
4314        __(lwi(arg_y,XIMPROPERLIST))
4315        __(set_nargs(2))
4316        __(b _SPksignalerr)
43179:      /* Whew */     
4318       
4319        /* Next, determine the length of arg_y.  We */
4320        /* know that it's a proper list. */
4321        __(li imm0,-4)
4322        __(mr temp4,arg_y)
43231:
4324        __(cmpri(cr0,temp4,nil_value))
4325        __(la imm0,4(imm0))
4326        __(_cdr(temp4,temp4))
4327        __(bne 1b)
4328        /* imm0 is now (boxed) triplet count. */
4329        /* Determine word count, add 1 (to align), and make room. */
4330        /* if count is 0, make an empty tsp frame and exit */
4331        __(cmpri(cr0,imm0,0))
4332        __(add imm1,imm0,imm0)
4333        __(add imm1,imm1,imm0)
4334        __(dnode_align(imm1,imm1,node_size))
4335        __(bne+ cr0,2f)
4336         __(TSP_Alloc_Fixed_Boxed(8))
4337         __(blr)
43382:
4339        __(la imm1,tsp_frame.fixed_overhead(imm1))      /* tsp header */
4340        __(TSP_Alloc_Var_Boxed_nz(imm1,imm2))
4341        __(str(imm0,tsp_frame.data_offset(tsp)))
4342        __(ldr(imm2,tsp_frame.backlink(tsp)))
4343        __(mr temp4,arg_y)
4344        __(ldr(imm1,tcr.db_link(rcontext)))
4345        __(ldr(imm3,tcr.tlb_limit(rcontext)))
43463:
4347        __(cmpri(cr1,arg_z,nil_value))
4348        __(_car(temp0,temp4))
4349        __(ldr(imm0,svar.idx(temp0)))
4350        __(_cdr(temp4,temp4))
4351        __(trlle(imm3,imm0))
4352        __(ldr(imm4,tcr.tlb_pointer(rcontext))) /* Need to reload after trap */
4353        __(ldrx(temp3,imm4,imm0))
4354        __(cmpri(cr0,temp4,nil_value))
4355        __(li temp2,unbound_marker)
4356        __(beq cr1,4f)
4357        __(_car(temp2,arg_z))
4358        __(_cdr(arg_z,arg_z))
43594:      __(push(temp3,imm2))
4360        __(push(imm0,imm2))
4361        __(push(imm1,imm2))
4362        __(strx(temp2,imm4,imm0))
4363        __(mr imm1,imm2)
4364        __(bne cr0,3b)
4365        __(str(imm2,tcr.db_link(rcontext)))
4366        __(blr)
4367               
4368_spentry(svar_progvrestore)
4369        __(ldr(imm0,tsp_frame.backlink(tsp)))   /* ignore .SPnthrowXXX values frame */
4370        __(ldr(imm0,tsp_frame.data_offset(imm0)))
4371        __(cmpri(cr0,imm0,0))
4372        __(unbox_fixnum(imm0,imm0))
4373        __(bne+ cr0,_SPsvar_unbind_n)
4374        __(blr)
4375                       
4376/*  EOF, basically */
4377        .globl _SPsp_end
4378        b _SPsp_end
4379        _endfile
Note: See TracBrowser for help on using the repository browser.