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

Last change on this file since 557 was 557, checked in by gb, 15 years ago

PPC64 changes (some of them rather suspect ...). 32-bit kernel may be a
little funky ...

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 127.8 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,-node_size(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,-node_size(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        __(ldru(temp0,-node_size(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        __(ldru(temp1,-node_size(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,-node_size(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        __(ldru(temp0,-node_size(imm1)))
235        __(stru(temp0,node_size(imm0)))
236        __(subi imm2,imm2,fixnum_one)
237local_label(_nthrowv_tpushtest):
238        __(cmpri(imm2,0))
239        __(bne local_label(_nthrowv_tpushloop))
240        __(stru(imm4,node_size(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        __(ldru(temp0,node_size(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,node_size(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+node_size(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+node_size(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,node_size(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,node_size(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,node_size(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,node_size(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,-node_size(nargs))
450        __(cmpri(cr1,nargs,0))
451        __(ldr(temp1,0(vsp)))
452        __(la vsp,node_size(vsp))
453        __(stru(temp1,-node_size(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)
506ifdef([PPC64],[
507        ],[       
508        __(rlwinm. imm2,arg_y,32-fixnumshift,0,(8+fixnumshift)-1)
509        __(unbox_fixnum(imm0,arg_z))
510        __(extract_fulltag(imm1,imm0))
511        __(bne- cr0,9f)
512        __(cmpri(cr0,imm1,fulltag_nodeheader))
513        __(mr imm3,imm0)
514        __(cmplri(cr1,imm0,max_32_bit_ivector_subtag))
515        __(rlwimi imm0,arg_y,num_subtag_bits-fixnum_shift,0,31-num_subtag_bits) /* imm0 now = header */
516        __(mr imm2,arg_y)
517        __(beq cr0,1f)  /* do probe if node object
518                           (fixnum element count = byte count). */
519        __(cmplri(cr0,imm3,max_16_bit_ivector_subtag))
520        __(bng cr1,1f) /* do probe if 32-bit imm object */
521        __(cmplri(cr1,imm3,max_8_bit_ivector_subtag))
522        __(srwi imm2,imm2,1)
523        __(bgt cr0,3f)
524        __(bgt cr1,1f)
525        __(srwi imm2,imm2,1)
526/* imm2 now = byte count.  Add 4 for header, 7 to align, then
527        clear low three bits. */
5281:
529        __(dnode_align(imm3,imm2,tsp_frame.fixed_overhead+node_size))
530        __(cmplri(cr0,imm3,tstack_alloc_limit)) /* more than limit ? */
531        __(bgt- cr0,0f)
532        __(TSP_Alloc_Var_Boxed_nz(imm3,imm4))
533
534/* Slap the header on the vector, then return. */
535        __(str(imm0,tsp_frame.data_offset(tsp)))
536        __(la arg_z,tsp_frame.data_offset+fulltag_misc(tsp))
537        __(blr)
5389:
539
540
541
542/* Too large to safely fit on tstack.  Heap-cons the vector, but make
543   sure that there's an empty tsp frame to keep the compiler happy. */
5440:
545        __(TSP_Alloc_Fixed_Unboxed(0))
546        __(b _SPmisc_alloc)
5473:
548        __(cmplri(imm3,subtag_double_float_vector))
549        __(slwi imm2,arg_y,1)
550        __(beq 1b)
551        __(addi imm2,arg_y,7<<fixnumshift)
552        __(srwi imm2,imm2,fixnumshift+3)
553        __(b 1b)
554])
555       
556/* subtype (boxed, of course) is vpushed, followed by nargs bytes worth of */
557/* initial-contents.  Note that this can be used to cons any type of initialized */
558/* node-header'ed misc object (symbols, closures, ...) as well as vector-like */
559/* objects. */
560/* Note that we're guaranteed to win (or force GC, or run out of memory) */
561/* because nargs < 32K. */
562_spentry(gvector)
563        __(ldrx(arg_z,vsp,nargs))
564        __(unbox_fixnum(imm0,arg_z))
565        __(rlwimi imm0,nargs,num_subtag_bits-fixnum_shift,0,31-num_subtag_bits)
566        __(dnode_align(imm1,nargs,node_size))
567        __(Misc_Alloc(arg_z,imm0,imm1))
568        __(mr imm1,nargs)
569        __(addi imm2,imm1,misc_data_offset)
570        __(b 2f)
5711:
572        __(stwx temp0,arg_z,imm2)
5732:
574        __(subi imm1,imm1,node_size)
575        __(cmpri(cr0,imm1,0))
576        __(subi imm2,imm2,node_size)
577        __(vpop(temp0))         /* Note the intentional fencepost:
578                                      discard the subtype as well. */
579        __(bge cr0,1b)
580        __(blr)
581       
582        .globl C(nvalret)
583       
584        /* Come here with saved context on top of stack. */
585_spentry(nvalret)
586C(nvalret):     
587        __(ldr(loc_pc,lisp_frame.savelr(sp)))
588        __(ldr(temp0,lisp_frame.savevsp(sp)))
589        __(ldr(fn,lisp_frame.savefn(sp)))
590        __(discard_lisp_frame())
591        __(b local_label(return_values))
592       
593/* funcall temp0, returning multiple values if it does. */
594_spentry(mvpass)
595        __(cmpri(cr0,nargs,4*nargregs))
596        __(mflr loc_pc)
597        __(mr imm0,vsp)
598        __(ble+ cr0,1f)
599         __(subi imm0,imm0,4*nargregs)
600         __(add imm0,imm0,nargs)
6011:
602        __(build_lisp_frame(fn,loc_pc,imm0))
603        __(ref_global(loc_pc,ret1val_addr))
604        __(li fn,0)
605        __(mtlr loc_pc)
606        __(do_funcall())
607       
608/* ret1valn returns "1 multiple value" when a called function does not */
609/* return multiple values.  Its presence on the stack (as a return address) */
610/* identifies the stack frame to code which returns multiple values. */
611
612_exportfn(C(ret1valn))
613        __(ldr(loc_pc,lisp_frame.savelr(sp)))
614        __(ldr(vsp,lisp_frame.savevsp(sp)))
615        __(mtlr loc_pc)
616        __(ldr(fn,lisp_frame.savefn(sp)))
617        __(discard_lisp_frame())
618        __(vpush(arg_z))
619        __(set_nargs(1))
620        __(blr)
621       
622_spentry(fitvals)
623        __(subf. imm0,nargs,imm0)
624        __(li imm1,nil_value)
625        __(bge 2f)
626        __(sub vsp,vsp,imm0)
627        __(blr)
6281:
629        __(subic. imm0,imm0,4)
630        __(vpush(imm1))
631        __(addi nargs,nargs,4)
6322:
633        __(bne 1b)
634        __(blr)
635
636
637_spentry(nthvalue)
638        __(add imm0,vsp,nargs)
639        __(ldr(imm1,0(imm0)))
640        __(cmplr(imm1,nargs))   /*  do unsigned compare:         if (n < 0) => nil. */
641        __(li arg_z,nil_value)
642        __(neg imm1,imm1)
643        __(subi imm1,imm1,node_size)
644        __(bge 1f)
645        __(ldrx(arg_z,imm0,imm1))
6461:     
647        __(la vsp,node_size(imm0))
648        __(blr)
649       
650
651        /* Come here to return multiple values when */
652        /* the caller's context isn't saved in a lisp_frame. */
653        /* lr, fn valid; temp0 = entry vsp */
654
655_spentry(values)
656        __(mflr loc_pc)
657local_label(return_values):     
658        __(ref_global(imm0,ret1val_addr))
659        __(li arg_z,nil_value)
660        /* max tsp frame is 4K. 8+8 is overhead for save_values_to_tsp below */
661        /* and @do_unwind in nthrowvalues in "sp_catch.s". */
662        __(cmpri(cr2,nargs,4096-(8+8)))
663        __(cmpr(cr1,imm0,loc_pc))
664        __(cmpri(cr0,nargs,fixnum_one))
665        __(bge cr2,2f)
666        __(beq+ cr1,3f)
667        __(mtlr loc_pc)
668        __(add imm0,nargs,vsp)
669        __(blt- cr0,1f)
670        __(ldr(arg_z,-node_size(imm0)))
6711:
672        __(mr vsp,temp0)
673        __(blr)
674
6752:
676        __(uuo_interr(error_too_many_values,nargs))
677        __(b 2b)
678
679/* Return multiple values to real caller. */
6803:
681        __(ldr(loc_pc,lisp_frame.savelr(sp)))
682        __(add imm1,nargs,vsp)
683        __(ldr(imm0,lisp_frame.savevsp(sp)))
684        __(ldr(fn,lisp_frame.savefn(sp)))
685        __(cmpr(cr0,imm1,imm0)) /* a fairly common case */
686        __(mtlr loc_pc)
687        __(cmpri(cr1,nargs,fixnum_one)) /* sadly, a very common case */
688        __(discard_lisp_frame())
689        __(beqlr cr0) /* already in the right place */
690        __(bne cr1,4f)
691         __(ldr(arg_z,0(vsp)))
692         __(mr vsp,imm0)
693         __(vpush(arg_z))
694         __(blr)
6954:
696        __(blt cr1,6f)
697        __(li imm2,fixnum_one)
6985:
699        __(cmpr(cr0,imm2,nargs))
700        __(addi imm2,imm2,fixnum_one)
701        __(ldru(arg_z,-node_size(imm1)))
702        __(push(arg_z,imm0))
703        __(bne cr0,5b)
7046:
705        __(mr vsp,imm0)
706        __(blr)
707       
708/* Provide default (NIL) values for &optional arguments; imm0 is
709   the (fixnum) upper limit on the total of required and &optional
710   arguments.  nargs is preserved, all arguments wind up on the
711   vstack. */
712_spentry(default_optional_args)
713        __(cmplr( cr7,nargs,imm0))
714        __(li imm5,nil_value)
715        __(vpush_argregs())
716        __(mr imm1,nargs)
717        __(bgelr cr7)
7181:     
719        __(addi imm1,imm1,fixnum_one)
720        __(cmpr(cr0,imm1,imm0))
721        __(vpush(imm5))
722        __(bne cr0,1b)
723        __(blr)
724       
725/* Indicate whether &optional arguments were actually supplied.  nargs
726   contains the actual arg count (minus the number of required args); 
727   imm0 contains the number of &optional args in the lambda list.
728   Note that nargs may be > imm0 if &rest/&key is involved. */
729_spentry(opt_supplied_p)
730        __(li imm1,0)
7311:
732        /* (vpush (< imm1 nargs)) */
733        __(xor imm2,imm1,nargs)
734        __(srawi imm2,imm2,31)
735        __(or imm2,imm2,imm1)
736        __(addi imm1,imm1,fixnumone)
737        __(cmpr(cr0,imm1,imm0))
738        __(subf imm2,nargs,imm2)
739        __(srwi imm2,imm2,31)
740        __(insrwi imm2,imm2,1,27)
741        __(addi imm2,imm2,nil_value)
742        __(vpush(imm2))
743        __(bne cr0,1b)
744        __(blr)
745       
746
747
748/* If nargs is <= imm0, vpush a nil.  Otherwise, cons a list of length
749   (- nargs imm0) and vpush it.
750   Use this entry point to heap-cons a simple &rest arg. */
751_spentry(heap_rest_arg)
752        __(li imm0,0)
753        __(vpush_argregs())
754        __(sub imm1,nargs,imm0)
755        __(cmpri(imm1,0))
756        __(li arg_z,nil_value)
757        __(b 2f)
7581:
759        __(ldr(temp0,0(vsp)))
760        __(cmpri(imm1,fixnum_one))
761        __(la vsp,node_size(vsp))
762        __(Cons(arg_z,temp0,arg_z))
763        __(subi imm1,imm1,fixnum_one)
7642:
765        __(bgt 1b)
766        __(vpush(arg_z))
767        __(blr)
768
769       
770/* And this entry point when the argument registers haven't yet been
771   vpushed (as is typically the case when required/&rest but no &optional/&key.) */
772_spentry(req_heap_rest_arg)
773        __(vpush_argregs())
774        __(sub imm1,nargs,imm0)
775        __(cmpri(imm1,0))
776        __(li arg_z,nil_value)
777        __(b 2f)
7781:
779        __(ldr(temp0,0(vsp)))
780        __(cmpri(imm1,fixnum_one))
781        __(la vsp,node_size(vsp))
782        __(Cons(arg_z,temp0,arg_z))
783        __(subi imm1,imm1,fixnum_one)
7842:
785        __(bgt 1b)
786        __(vpush(arg_z))
787        __(blr)
788
789
790_spentry(heap_cons_rest_arg)
791        __(sub imm1,nargs,imm0)
792        __(cmpri(imm1,0))
793        __(li arg_z,nil_value)
794        __(b 2f)
7951:
796        __(ldr(temp0,0(vsp)))
797        __(cmpri(imm1,fixnum_one))
798        __(la vsp,node_size(vsp))
799        __(Cons(arg_z,temp0,arg_z))
800        __(subi imm1,imm1,fixnum_one)
8012:
802        __(bgt 1b)
803        __(vpush(arg_z))
804        __(blr)
805
806       
807_spentry(simple_keywords)
808        __(li imm0,0)
809        __(vpush_argregs())
810        __(b _SPkeyword_bind)
811               
812_spentry(keyword_args)
813        __(vpush_argregs())
814        __(b _SPkeyword_bind)
815
816/* Treat the last (- nargs imm0) values on the vstack as keyword/value
817   pairs.  There'll be imm3 keyword arguments.  Imm2 contains flags
818   that indicate whether &allow-other-keys was specified and whether
819   or not to leave the keyword/value pairs on the vstack for an &rest
820   argument.  Temp3 contains a vector of keyword specifiers which we
821   must (in general) match.
822   If the number of arguments is greater than imm0, the difference must
823   be even.
824   Note that the caller hasn't yet saved its caller's context and that
825   the temp registers used to pass closure_data (temp0) and next_method_context
826   (temp1) may still have "live" values in them, as does nfn (temp2). */
827
828define([keyword_flags],[imm2])
829define([keyword_vector],[temp3])
830define([keyword_count],[imm3])
831
832
833
834define([varptr],[save0])
835define([valptr],[save1])
836define([limit],[save2])
837
838_spentry(keyword_bind)
839        /* Before we can really do anything, we have to */
840        /* save the caller's context.  To do so, we need to know */
841        /* how many args have actually been pushed.  Ordinarily, that'd */
842        /* be "nargs", but we may have pushed more args than we received */
843        /* if we had to default any &optionals. */
844        /* So, the number of args pushed so far is the larger of nargs */
845        /* and the (canonical) total of required/&optional args received. */
846        __(cmpr(cr0,nargs,imm0))
847        __(add arg_z,vsp,nargs)
848        __(bge+ cr0,1f)
849        __(add arg_z,vsp,imm0)
8501:
851        __(build_lisp_frame(fn,loc_pc,arg_z))
852        __(mr fn,nfn)
853        /* If there are key/value pairs to consider, we slide them down */
854        /* the vstack to make room for the value/supplied-p pairs. */
855        /* The first step in that operation involves pushing imm3 pairs */
856        /* of NILs. */
857        /* If there aren't any such pairs, the first step is the last */
858        /* step. */
859        __(cmpri(cr0,imm3,0))
860        __(li arg_z,0)
861        __(sub imm1,nargs,imm0)
862        __(mr imm4,vsp) /* in case odd keywords error */
863        __(cmpri(cr1,imm1,0))
864        __(b 3f)
8652:
866        __(addi arg_z,arg_z,fixnum_one)
867        __(cmplr(cr0,arg_z,imm3))
868        __(li imm5,nil_value)
869        __(vpush(imm5))
870        __(vpush(imm5))
8713:
872        __(bne cr0,2b)
873        __(andi. arg_z,imm1,fixnum_one)
874        __(blelr cr1)   /* no keyword/value pairs to consider. */
875        __(bne cr0,odd_keywords)
876        /* We have key/value pairs.  Move them to the top of the vstack, */
877        /* then set the value/supplied-p vars to NIL. */
878        /* Have to use some save regs to do this. */
879        __(vpush(limit))
880        __(vpush(valptr))
881        __(vpush(varptr))
882        /* recompute ptr to user args in case stack overflowed */
883        __(add imm4,vsp,imm3)
884        __(add imm4,imm4,imm3)
885        __(addi imm4,imm4,12)
886        /* error if odd number of keyword/value args */
887        __(mr varptr,imm4)
888        __(la limit,12(vsp))
889        __(mr valptr,limit)
890        __(mr arg_z,imm1)
8914:
892        __(li imm4,nil_value)
893        __(subi arg_z,arg_z,2<<fixnumshift)
894        __(cmplri(cr0,arg_z,0))
895        __(ldr(arg_x,node_size*0(varptr)))
896        __(ldr(arg_y,node_size*1(varptr)))
897        __(str(imm4,node_size*0(varptr)))
898        __(str(imm4,node_size*1(varptr)))
899        __(la varptr,node_size*2(varptr))
900        __(str(arg_x,node_size*0(valptr)))
901        __(str(arg_y,node_size*1(valptr)))
902        __(la valptr,node_size*2(valptr))
903        __(bne cr0,4b)
904
905
906/* Now, iterate through each supplied keyword/value pair.  If
907   it's :allow-other-keys and the corresponding value is non-nil, 
908   note that other keys will be allowed.
909   Find its position in the function's keywords vector.  If that's
910   nil, note that an unknown keyword was encountered.
911   Otherwise, if the keyword arg hasn't already had a value supplied,
912   supply it.
913   When done, complain if any unknown keywords were found and that
914   situation was unexpected. */
915        __(mr imm4,valptr)
9165:
917        __(cmpwi cr0,keyword_flags,16<<fixnumshift) /* seen :a-o-k yet ? */
918        __(ldru(arg_z,-node_size(valptr)))
919        __(ldru(arg_y,-node_size(valptr)))
920        __(cmpri(cr1,arg_y,nil_value))
921        __(li arg_x,nrs.kallowotherkeys)
922        /* cr6_eq <- (eq current-keyword :allow-other-keys) */
923        __(cmpr(cr6,arg_x,arg_z))
924        __(cmpr(cr7,valptr,limit))
925        __(bne cr6,6f)
926        __(bge cr0,6f) /* Already seen :allow-other-keys */
927        __(ori keyword_flags,keyword_flags,16<<fixnumshift)
928        __(beq cr1,6f)
929        __(ori keyword_flags,keyword_flags,fixnum_one)
9306:
931        __(cmpri(cr1,imm3,0))
932        __(li imm1,misc_data_offset)
933        __(li imm0,0)
934        __(b 8f)
9357:
936        __(addi imm0,imm0,fixnum_one)
937        __(cmpr(cr1,imm0,imm3))
938        __(ldrx(arg_x,keyword_vector,imm1))
939        __(cmpr(cr0,arg_x,arg_z))
940        __(addi imm1,imm1,fixnum_one)
941        __(bne cr0,8f)
942        __(add imm0,imm0,imm0)
943        __(sub imm0,varptr,imm0)
944        __(ldr(arg_x,0(imm0)))
945        __(cmpri(cr0,arg_x,nil_value))
946        __(li arg_z,t_value)
947        __(bne cr0,9f)
948        __(str(arg_y,node_size(imm0)))
949        __(str(arg_z,0(imm0)))
950        __(b 9f)
9518:
952        __(bne cr1,7b)
953        /* Unknown keyword. If it was :allow-other-keys, cr6_eq will still
954           be set. */
955        __(beq cr6,9f)
956        __(ori keyword_flags,keyword_flags,2<<fixnumshift)
9579:
958        __(bne cr7,5b)
959        __(vpop(varptr))
960        __(vpop(valptr))
961        __(vpop(limit))
962        /* All keyword/value pairs have been processed. */
963        /* If we saw an unknown keyword and didn't expect to, error. */
964        /* Unless bit 2 is set in the fixnum in keyword_flags, discard the */
965        /* keyword/value pairs from the vstack. */
966        __(andi. imm0,keyword_flags,(fixnum_one)|(2<<fixnumshift))
967        __(cmpri(cr0,imm0,2<<fixnumshift))
968        __(beq- cr0,badkeys)
969        __(andi. imm2,keyword_flags,4<<fixnumshift)
970        __(bnelr cr0)
971        __(mr vsp,imm4)
972        __(blr)
973
974/* Signal an error.  We saved context on entry, so this thing doesn't
975   have to.
976   The "unknown keywords" error could be continuable (ignore them.)
977   It might be hard to then cons an &rest arg.
978   In the general case, it's hard to recover the set of args that were
979   actually supplied to us ... */
980        /* For now, just cons a list out of the keyword/value pairs */
981        /* that were actually provided, and signal an "invalid keywords" */
982        /* error with that list as an operand. */
983odd_keywords:
984        __(mr vsp,imm4)
985        __(mr nargs,imm1)
986        __(b 1f)
987badkeys:
988        __(sub nargs,imm4,vsp)
9891:
990        .globl _SPconslist
991        __(bl _SPconslist)
992        __(li arg_y,XBADKEYS)
993        __(set_nargs(2))
994        __(b _SPksignalerr)
995
996/*
997  A PowerOpen ff-call.  arg_z is either a fixnum (word-aligned entrypoint)
998  or a macptr (whose address had better be word-aligned as well.)  A
999  PowerOpen stack frame is on top of the stack; 4 additional words (to
1000  be used a a lisp frame) sit under the C frame.
1001
1002  Since we probably can't deal with FP exceptions in foreign code, we
1003  disable them in the FPSCR, then check on return to see if any previously
1004  enabled FP exceptions occurred.
1005
1006  As it turns out, we can share a lot of code with the eabi version of
1007  ff-call.  Some things that happen up to the point of call differ between
1008  the ABIs, but everything that happens after is the same.
1009*/
1010       
1011_spentry(ffcall)
1012        __(mflr loc_pc)
1013        __(vpush_saveregs())            /* Now we can use save0-save7 to point to stacks */
1014        __(mr save0,rcontext)   /* or address globals. */
1015        __(extract_typecode(imm0,arg_z))
1016        __(cmpri(cr7,imm0,subtag_macptr))
1017        __(ldr(save1,0(sp)))    /* bottom of reserved lisp frame */
1018        __(la save2,-lisp_frame.size(save1))    /* top of lisp frame*/
1019        __(zero_doublewords save2,0,lisp_frame.size)
1020        __(str(save1,lisp_frame.backlink(save2)))
1021        __(str(save2,c_frame.backlink(sp)))
1022        __(str(fn,lisp_frame.savefn(save2)))
1023        __(str(loc_pc,lisp_frame.savelr(save2)))
1024        __(str(vsp,lisp_frame.savevsp(save2)))
1025        __(bne cr7,1f)
1026        __(ldr(arg_z,macptr.address(arg_z)))
10271:
1028        __(ldr(save3,tcr.cs_area(rcontext)))
1029        __(str(save2,area.active(save3)))
1030        __(str(allocptr,tcr.save_allocptr(rcontext)))
1031        __(str(allocbase,tcr.save_allocbase(rcontext)))
1032        __(str(tsp,tcr.save_tsp(rcontext)))
1033        __(str(vsp,tcr.save_vsp(rcontext)))
1034        __(str(rzero,tcr.ffi_exception(rcontext)))
1035        __(mffs f0)
1036        __(stfd f0,tcr.lisp_fpscr(rcontext))    /* remember lisp's fpscr */
1037        __(mtfsf 0xff,fp_zero)  /* zero foreign fpscr */
1038        __(li r4,TCR_STATE_FOREIGN)
1039        __(str(r4,tcr.valence(rcontext)))
1040        __(li rcontext,0)
1041        __(mtctr arg_z)
1042        __(ldr(r3,c_frame.param0(sp)))
1043        __(ldr(r4,c_frame.param1(sp)))
1044        __(ldr(r5,c_frame.param2(sp)))
1045        __(ldr(r6,c_frame.param3(sp)))
1046        __(ldr(r7,c_frame.param4(sp)))
1047        __(ldr(r8,c_frame.param5(sp)))
1048        __(ldr(r9,c_frame.param6(sp)))
1049        __(ldr(r10,c_frame.param7(sp)))
1050        /* Darwin is allegedly very picky about what register points
1051           to the function on entry. */
1052        __(mr r12,arg_z)
1053        __(bctrl)
1054        __(b _local_label(FF_call_return_common))
1055
1056_spentry(ffcalladdress)
1057        __(b _SPbreakpoint)
1058       
1059/* Signal an error synchronously, via %ERR-DISP. */
1060/* If %ERR-DISP isn't fbound, it'd be nice to print a message */
1061/* on the C runtime stderr. */
1062
1063_spentry(ksignalerr)
1064        __(li fname,nrs.errdisp)
1065        __(jump_fname)
1066       
1067/* As in the heap-consed cases, only stack-cons the &rest arg */
1068_spentry(stack_rest_arg)
1069        __(li imm0,0)
1070        __(vpush_argregs())
1071        __(b _SPstack_cons_rest_arg)
1072
1073       
1074_spentry(req_stack_rest_arg)
1075        __(vpush_argregs())
1076        __(b _SPstack_cons_rest_arg)
1077       
1078_spentry(stack_cons_rest_arg)
1079        __(sub imm1,nargs,imm0)
1080        __(cmpri(cr0,imm1,0))
1081        __(cmpri(cr1,imm1,(4096-8)/2))
1082        __(li arg_z,nil_value)
1083        __(ble cr0,2f)          /* always temp-push something. */
1084        __(bge cr1,3f)
1085        __(add imm1,imm1,imm1)
1086        __(dnode_align(imm2,imm1,tsp_frame.fixed_overhead))
1087        __(TSP_Alloc_Var_Boxed(imm2,imm3))
1088        __(la imm0,tsp_frame.data_offset+fulltag_cons(tsp))
10891:
1090        __(cmpri(cr0,imm1,8))   /* last time through ? */
1091        __(subi imm1,imm1,8)
1092        __(vpop(arg_x))
1093        __(rplacd(imm0,arg_z))
1094        __(rplaca(imm0,arg_x))
1095        __(mr arg_z,imm0)
1096        __(la imm0,cons.size(imm0))
1097        __(bne cr0,1b)
1098        __(vpush(arg_z))
1099        __(blr)
11002:
1101        __(TSP_Alloc_Fixed_Unboxed(0))
1102        __(vpush(arg_z))
1103        __(blr)
11043:
1105        __(TSP_Alloc_Fixed_Unboxed(0))
1106        __(b _SPheap_cons_rest_arg)
1107
1108
1109_spentry(callbackX)       
1110        /* Save C argument registers */
1111        __(str(r3,c_frame.param0(sp)))
1112        __(str(r4,c_frame.param1(sp)))
1113        __(str(r5,c_frame.param2(sp)))
1114        __(str(r6,c_frame.param3(sp)))
1115        __(str(r7,c_frame.param4(sp)))
1116        __(str(r8,c_frame.param5(sp)))
1117        __(str(r9,c_frame.param6(sp)))
1118        __(str(r10,c_frame.param7(sp)))
1119        __(mflr imm3)
1120        __(str(imm3,c_frame.savelr(sp)))
1121        __(mfcr imm0)
1122        __(str(imm0,c_frame.crsave(sp)))
1123
1124        /* Save the non-volatile registers on the sp stack */
1125        /* This is a non-standard stack frame, but noone will ever see it, */
1126        /* so it doesn't matter. It will look like more of the stack frame pushed below. */
1127        __(stru(sp,-(stack_align(c_reg_save.size))(sp)))
1128        __(stmw r13,c_reg_save.save_gprs(sp))
1129        __(check_stack_alignment(r0))
1130        __(mffs f0)
1131        __(stfd f0,c_reg_save.save_fp_zero(sp))
1132        __(ldr(r31,c_reg_save.save_fp_zero+4(sp)))      /* recover FPSCR image */
1133        __(str(r31,c_reg_save.save_fpscr(sp)))
1134        __(lwi(r30,0x43300000))
1135        __(lwi(r31,0x80000000))
1136        __(str(r30,c_reg_save.save_fp_zero(sp)))
1137        __(str(r31,c_reg_save.save_fp_zero+4(sp)))
1138        __(stfd fp_s32conv,c_reg_save.save_fps32conv(sp))
1139        __(lfd fp_s32conv,c_reg_save.save_fp_zero(sp))
1140        __(stfd fp_zero,c_reg_save.save_fp_zero(sp))
1141        __(lfs fp_zero,lisp_globals.short_float_zero(0))        /* ensure that fp_zero contains 0.0 */
1142
1143/* Restore rest of Lisp context. */
1144/* Could spread out the memory references here to gain a little speed */
1145
1146        __(li loc_pc,0)
1147        __(li fn,0)                     /* subprim, not a lisp function */
1148        __(li temp4,0)
1149        __(li temp3,0)
1150        __(li temp2,0)
1151        __(li temp1,0)
1152        __(li temp0,0)
1153        __(li arg_x,0)
1154        __(box_fixnum(arg_y,r11))       /* callback-index */
1155        __(la arg_z,stack_align(c_reg_save.size)+c_frame.param0(sp))    /* parameters (tagged as a fixnum) */
1156
1157        /* Recover lisp thread context. Have to call C code to do so. */
1158        __(ref_global(r12,get_tcr))
1159        __(mtctr r12)
1160        __(li r3,1)
1161        __(stru(sp,-(stack_align(c_frame.minsiz))(sp)))
1162        __(bctrl)
1163        __(mr rcontext,r3)
1164        /* re-establish lisp exception handling */
1165        __(ref_global(r12,lisp_return_hook))
1166        __(mtctr r12)
1167        __(bctrl)
1168        __(la sp,(stack_align(c_frame.minsiz))(sp))
1169
1170        __(ldr(vsp,tcr.save_vsp(rcontext)))
1171        __(ldr(tsp,tcr.save_tsp(rcontext)))             
1172        __(li rzero,0)
1173        __(mtxer rzero) /* lisp wants the overflow bit clear */
1174        __(li imm0,TCR_STATE_FOREIGN)
1175        __(li save0,0)
1176        __(li save1,0)
1177        __(li save2,0)
1178        __(li save3,0)
1179        __(li save4,0)
1180        __(li save5,0)
1181        __(li save6,0)
1182        __(li save7,0)
1183        __(lfd f0,tcr.lisp_fpscr(rcontext))
1184        __(mtfsf 0xff,f0)
1185        __(li allocptr,0)
1186        __(li allocbase,0)
1187        __(str(imm0,tcr.valence(rcontext)))
1188        __(ldr(allocptr,tcr.save_allocptr(rcontext)))
1189        __(ldr(allocbase,tcr.save_allocbase(rcontext)))
1190       
1191        /* load nargs and callback to the lisp */
1192        __(set_nargs(2))
1193        __(ldr(imm2,tcr.cs_area(rcontext)))
1194        __(ldr(imm4,area.active(imm2)))
1195        __(stru(imm4,-lisp_frame.size(sp)))
1196        __(str(imm3,lisp_frame.savelr(sp)))
1197        __(str(vsp,lisp_frame.savevsp(sp)))     /* for stack overflow code */
1198        __(li fname,nrs.callbacks)      /* %pascal-functions% */
1199        __(call_fname)
1200        __(ldr(imm2,lisp_frame.backlink(sp)))
1201        __(ldr(imm3,tcr.cs_area(rcontext)))
1202        __(str(imm2,area.active(imm3)))
1203        __(discard_lisp_frame())
1204        /* save_vsp will be restored from ff_call's stack frame, but */
1205        /* I included it here for consistency. */
1206        /* save_tsp is set below after we exit Lisp context. */
1207        __(str(allocptr,tcr.save_allocptr(rcontext)))
1208        __(str(allocbase,tcr.save_allocbase(rcontext)))
1209        __(str(vsp,tcr.save_vsp(rcontext)))
1210        __(str(tsp,tcr.save_tsp(rcontext)))
1211
1212        __(li imm1,TCR_STATE_FOREIGN)
1213        __(str(imm1,tcr.valence(rcontext)))
1214        __(mr r3,rcontext)
1215        __(ldr(r4,tcr.foreign_exception_status(rcontext)))
1216        __(cmpri(r4,0))
1217        /* Restore the non-volatile registers & fpscr */
1218        __(lfd fp_zero,c_reg_save.save_fp_zero(sp))
1219        __(ldr(r31,c_reg_save.save_fpscr(sp)))
1220        __(str(r31,c_reg_save.save_fp_zero+4(sp)))
1221        __(lfd f0,c_reg_save.save_fp_zero(sp))
1222        __(mtfsf 0xff,f0)
1223        __(lmw r13,c_reg_save.save_gprs(sp))
1224        __(lfd fp_s32conv,c_reg_save.save_fps32conv(sp))
1225        __(beq 9f)
1226        __(ref_global(r12,lisp_exit_hook))
1227        __(mtctr r12)
1228        __(bctrl)
12299:     
1230        __(ldr(sp,0(sp)))
1231        __(ldr(r3,c_frame.param0(sp)))
1232        __(ldr(r4,c_frame.param0(sp)))
1233        __(ldr(r5,c_frame.savelr(sp)))
1234        __(mtlr r5)
1235        __(ldr(r5,c_frame.crsave(sp)))
1236        __(mtcr r5)
1237        __(blr)
1238       
1239/* Prepend all but the first two (closure code, fn) and last two */
1240/* (function name, lfbits) elements of nfn to the "arglist". */
1241/* Doing things this way (the same way that 68K MCL does) lets */
1242/* functions which take "inherited arguments" work consistently */
1243/* even in cases where no closure object is created. */
1244_spentry(call_closure)       
1245        __(cmpri(cr0,nargs,nargregs<<fixnumshift))
1246        __(cmpri(cr1,nargs,fixnum_one))
1247        __(vector_length(imm0,nfn,imm0))
1248        __(subi imm0,imm0,4<<fixnumshift) /* imm0 = inherited arg count */
1249        __(li imm1,misc_data_offset+(2<<fixnumshift)) /* point to 1st arg */
1250        __(li imm4,nil_value)
1251        __(ble+ cr0,local_label(no_insert))
1252        /* Some arguments have already been vpushed.  Vpush imm0's worth */
1253        /* of NILs, copy those arguments that have already been vpushed from */
1254        /* the old TOS to the new, then insert all of the inerited args */
1255        /* and go to the function. */
1256        __(li imm2,0)
1257local_label(push_nil_loop):
1258        __(addi imm2,imm2,fixnum_one)
1259        __(cmpr(cr2,imm2,imm0))
1260        __(vpush(imm4))
1261        __(bne cr2,local_label(push_nil_loop))
1262
1263        __(mr imm3,vsp)
1264        __(add imm4,vsp,imm0)
1265        __(subi imm2,nargs,nargregs<<fixnumshift)
1266local_label(copy_already_loop):
1267        __(cmpri(cr2,imm2,fixnum_one))
1268        __(subi imm2,imm2,fixnum_one)
1269        __(ldr(fname,0(imm4)))
1270        __(addi imm4,imm4,fixnum_one)
1271        __(str(fname,0(imm3)))
1272        __(addi imm3,imm3,fixnum_one)
1273        __(bne cr2,local_label(copy_already_loop))
1274
1275local_label(insert_loop):
1276        __(cmpri(cr2,imm0,fixnum_one))
1277        __(ldrx(fname,nfn,imm1))
1278        __(addi imm1,imm1,fixnum_one)
1279        __(addi nargs,nargs,fixnum_one)
1280        __(subi imm0,imm0,fixnum_one)
1281        __(push(fname,imm4))
1282        __(bne cr2,local_label(insert_loop))
1283        __(b local_label(go))
1284local_label(no_insert):
1285        /* nargregs or fewer args were already vpushed. */
1286        /* if exactly nargregs, vpush remaining inherited vars. */
1287        __(add imm2,imm1,imm0)
1288        __(bne cr0,local_label(set_regs))
1289local_label(vpush_remaining):
1290        __(cmpri(cr2,imm0,fixnum_one))
1291        __(ldrx(fname,nfn,imm1))
1292        __(addi imm1,imm1,fixnum_one)
1293        __(vpush(fname))
1294        __(subi imm0,imm0,fixnum_one)
1295        __(addi nargs,nargs,fixnum_one)
1296        __(bne cr2,local_label(vpush_remaining))
1297        __(b local_label(go))
1298local_label(set_regs):
1299        /* if nargs was > 1 (and we know that it was < 3), it must have */
1300        /* been 2.  Set arg_x, then vpush the remaining args. */
1301        __(ble cr1,local_label(set_y_z))
1302local_label(set_arg_x):
1303        __(subi imm0,imm0,fixnum_one)
1304        __(cmpri(cr0,imm0,0))
1305        __(subi imm2,imm2,fixnum_one)
1306        __(ldrx(arg_x,nfn,imm2))
1307        __(addi nargs,nargs,fixnum_one)
1308        __(bne cr0,local_label(vpush_remaining))
1309        __(b local_label(go))
1310        /* Maybe set arg_y or arg_z, preceding args */
1311local_label(set_y_z):
1312        __(bne cr1,local_label(set_arg_z))
1313        /* Set arg_y, maybe arg_x, preceding args */
1314local_label(set_arg_y):
1315        __(subi imm0,imm0,fixnum_one)
1316        __(cmpri(cr0,imm0,0))
1317        __(subi imm2,imm2,fixnum_one)
1318        __(ldrx(arg_y,nfn,imm2))
1319        __(addi nargs,nargs,fixnum_one)
1320        __(bne cr0,local_label(set_arg_x))
1321        __(b local_label(go))
1322local_label(set_arg_z):
1323        __(subi imm0,imm0,fixnum_one)
1324        __(cmpri(cr0,imm0,0))
1325        __(subi imm2,imm2,fixnum_one)
1326        __(ldrx(arg_z,nfn,imm2))
1327        __(addi nargs,nargs,fixnum_one)
1328        __(bne cr0,local_label(set_arg_y))
1329
1330local_label(go):
1331        __(vrefr(nfn,nfn,1))
1332        __(ldr(loc_pc,_function.codevector(nfn)))
1333        __(mtctr loc_pc)
1334        __(bctr)
1335       
1336/*This (for better or worse) treats anything that's either */
1337/* (signed-byte 32), (unsigned-byte 32), (simple-base-string 4), or  */
1338/* (satisfies (lambda (s) (and (symbolp s) (typep (symbol-name s) '(simple-base-string 4))) */
1339/* as if it denoted a 32-bit value. */
1340/* Argument in arg_z, result in imm0.  May use temp0. */
1341_spentry(getxlong)
1342ifdef([PPC64],[
1343        ],[       
1344        __(extract_lisptag(imm0,arg_z))
1345        __(cmpri(cr0,imm0,tag_fixnum))
1346        __(cmpri(cr1,imm0,tag_misc))
1347        __(unbox_fixnum(imm0,arg_z))
1348        __(beqlr cr0)
1349        __(mr temp0,arg_z)
1350        __(bne- cr1,local_label(error))
1351        __(getvheader(imm0,temp0))
1352        __(cmpri(cr0,imm0,symbol_header))
1353        __(cmpri(cr1,imm0,one_digit_bignum_header))
1354        __(cmpri(cr7,imm0,two_digit_bignum_header))
1355        __(bne- cr0,local_label(not_sym))
1356        __(ldr(temp0,symbol.pname(arg_z)))
1357        __(getvheader(imm0,temp0))
1358local_label(not_sym):
1359        __(cmpri(cr0,imm0,(4<<num_subtag_bits)|subtag_simple_base_string))
1360        __(beq cr1,local_label(big1))
1361        __(beq cr0,local_label(big1))
1362        __(bne cr7,local_label(error))
1363
1364local_label(big2):
1365        __(vrefr(imm0,temp0,1)) /* sign digit must be 0 */
1366        __(cmpri(imm0,0))
1367        __(bne local_label(error))
1368local_label(big1):
1369        __(vrefr(imm0,temp0,0))
1370        __(blr)
1371
1372
1373local_label(error):
1374        __(uuo_interr(error_object_not_integer,arg_z)) /* not quite right but what 68K MCL said */
1375
1376])
1377               
1378/* Everything up to the last arg has been vpushed, nargs is set to
1379   the (boxed) count of things already pushed.
1380   On exit, arg_x, arg_y, arg_z, and nargs are set as per a normal
1381   function call (this may require vpopping a few things.)
1382   ppc2-invoke-fn assumes that temp1 is preserved here. */
1383_spentry(spreadargz)
1384ifdef([PPC64],[
1385        ],[       
1386        __(extract_lisptag(imm1,arg_z))
1387        __(cmpri(cr1,imm1,tag_list))
1388        __(cmpri(cr0,arg_z,nil_value))
1389        __(li imm0,0)
1390        __(mr arg_y,arg_z)              /*  save in case of error */
1391        __(beq cr0,2f)
13921:
1393        __(bne- cr1,3f)
1394        __(_car(arg_x,arg_z))
1395        __(_cdr(arg_z,arg_z))
1396        __(cmpri(cr0,arg_z,nil_value))
1397        __(extract_lisptag(imm1,arg_z))
1398        __(cmpri(cr1,imm1,tag_list))
1399        __(vpush(arg_x))
1400        __(addi imm0,imm0,fixnum_one)
1401        __(bne cr0,1b)
14022:
1403        __(add. nargs,nargs,imm0)
1404        __(cmpri(cr2,nargs,2<<fixnumshift))
1405        __(beqlr- cr0)
1406        __(vpop(arg_z))
1407        __(bltlr cr2)
1408        __(vpop(arg_y))
1409        __(beqlr cr2)
1410        __(vpop(arg_x))
1411        __(blr)
1412/*  Discard whatever's been vpushed already, complain. */
14133:     
1414        __(add vsp,vsp,imm0)
1415        __(mr arg_z,arg_y)              /* recover original arg_z */
1416        __(li arg_y,XNOSPREAD)
1417        __(set_nargs(2))
1418        __(b _SPksignalerr)
1419])
1420       
1421/* Tail-recursively funcall temp0. */
1422        /* Pretty much the same as the tcallsym* cases above. */
1423_spentry(tfuncallgen)
1424        __(cmpri(cr0,nargs,nargregs<<fixnumshift))
1425        __(ldr(loc_pc,lisp_frame.savelr(sp)))
1426        __(ldr(fn,lisp_frame.savefn(sp)))
1427        __(mtlr loc_pc)
1428        __(ble cr0,2f)
1429        __(ldr(imm0,lisp_frame.savevsp(sp)))
1430        __(discard_lisp_frame())
1431        /* can use nfn (= temp2) as a temporary */
1432        __(subi imm1,nargs,nargregs<<fixnumshift)
1433        __(add imm1,imm1,vsp)
14341:
1435        __(ldru(temp2,-node_size(imm1)))
1436        __(cmpr(cr0,imm1,vsp))
1437        __(push(temp2,imm0))
1438        __(bne cr0,1b)
1439        __(mr vsp,imm0)
1440        __(do_funcall())
14412:
1442        __(ldr(vsp,lisp_frame.savevsp(sp)))
1443        __(discard_lisp_frame())
1444        __(do_funcall())
1445
1446
1447        /* Some args were vpushed.  Slide them down to the base of */
1448        /* the current frame, then do funcall. */
1449_spentry(tfuncallslide)
1450        __(ldr(loc_pc,lisp_frame.savelr(sp)))
1451        __(ldr(fn,lisp_frame.savefn(sp)))
1452        __(ldr(imm0,lisp_frame.savevsp(sp)))
1453        __(discard_lisp_frame())
1454        /* can use nfn (= temp2) as a temporary */
1455        __(subi imm1,nargs,nargregs<<fixnumshift)
1456        __(add imm1,imm1,vsp)
1457        __(mtlr loc_pc)
14581:
1459        __(ldru(temp2,-node_size(imm1)))
1460        __(cmpr(cr0,imm1,vsp))
1461        __(push(temp2,imm0))
1462        __(bne cr0,1b)
1463        __(mr vsp,imm0)
1464        __(do_funcall())
1465
1466        /* No args were vpushed; recover saved context & do funcall */
1467_spentry(tfuncallvsp)
1468        __(ldr(loc_pc,lisp_frame.savelr(sp)))
1469        __(ldr(fn,lisp_frame.savefn(sp)))
1470        __(ldr(vsp,lisp_frame.savevsp(sp)))
1471        __(mtlr loc_pc)
1472        __(discard_lisp_frame())
1473        __(do_funcall())
1474       
1475/* Tail-recursively call the (known symbol) in fname. */
1476/* In the general case, we don't know if any args were */
1477/* vpushed or not.  If so, we have to "slide" them down */
1478/* to the base of the frame.  If not, we can just restore */
1479/* vsp, lr, fn from the saved lisp frame on the control stack. */
1480_spentry(tcallsymgen)
1481        __(cmpri(cr0,nargs,nargregs<<fixnumshift))
1482        __(ldr(loc_pc,lisp_frame.savelr(sp)))
1483        __(ldr(fn,lisp_frame.savefn(sp)))
1484        __(mtlr loc_pc)
1485        __(ble cr0,2f)
1486
1487        __(ldr(imm0,lisp_frame.savevsp(sp)))
1488        __(discard_lisp_frame())
1489        /* can use nfn (= temp2) as a temporary */
1490        __(subi imm1,nargs,nargregs<<fixnumshift)
1491        __(add imm1,imm1,vsp)
14921:
1493        __(ldru(temp2,-node_size(imm1)))
1494        __(cmpr(cr0,imm1,vsp))
1495        __(push(temp2,imm0))
1496        __(bne cr0,1b)
1497        __(mr vsp,imm0)
1498        __(jump_fname)
1499       
15002:             
1501        __(ldr(vsp,lisp_frame.savevsp(sp)))
1502        __(discard_lisp_frame())
1503        __(jump_fname)
1504       
1505       
1506/* Some args were vpushed.  Slide them down to the base of */
1507/* the current frame, then do funcall. */
1508_spentry(tcallsymslide)
1509        __(ldr(loc_pc,lisp_frame.savelr(sp)))
1510        __(ldr(fn,lisp_frame.savefn(sp)))
1511        __(ldr(imm0,lisp_frame.savevsp(sp)))
1512        __(discard_lisp_frame())
1513        __(mtlr loc_pc)
1514        /* can use nfn (= temp2) as a temporary */
1515        __(subi imm1,nargs,nargregs<<fixnumshift)
1516        __(add imm1,imm1,vsp)
15171:
1518        __(ldru(temp2,-node_size(imm1)))
1519        __(cmpr(cr0,imm1,vsp))
1520        __(push(temp2,imm0))
1521        __(bne cr0,1b)
1522        __(mr vsp,imm0)
1523        __(jump_fname)
1524
1525/* No args were vpushed; recover saved context & call symbol */
1526_spentry(tcallsymvsp)
1527        __(ldr(loc_pc,lisp_frame.savelr(sp)))
1528        __(ldr(fn,lisp_frame.savefn(sp)))
1529        __(ldr(vsp,lisp_frame.savevsp(sp)))
1530        __(discard_lisp_frame())
1531        __(mtlr loc_pc)
1532        __(jump_fname)
1533       
1534/* Tail-recursively call the function in nfn. */
1535        /* Pretty much the same as the tcallsym* cases above. */
1536_spentry(tcallnfngen)
1537        __(cmpri(cr0,nargs,nargregs<<fixnumshift))
1538        __(ble cr0,_SPtcallnfnvsp)
1539        __(b _SPtcallnfnslide)
1540
1541/* Some args were vpushed.  Slide them down to the base of */
1542/* the current frame, then do funcall. */
1543_spentry(tcallnfnslide)
1544        __(ldr(loc_pc,lisp_frame.savelr(sp)))
1545        __(ldr(fn,lisp_frame.savefn(sp)))
1546        __(ldr(imm0,lisp_frame.savevsp(sp)))
1547        __(discard_lisp_frame())
1548        __(mtlr loc_pc)
1549        /* Since we have a known function, can use fname as a temporary. */
1550        __(subi imm1,nargs,nargregs<<fixnumshift)
1551        __(add imm1,imm1,vsp)
15521:
1553        __(ldru(fname,-node_size(imm1)))
1554        __(cmpr(cr0,imm1,vsp))
1555        __(push(fname,imm0))
1556        __(bne cr0,1b)
1557        __(mr vsp,imm0)
1558        __(jump_nfn())
1559       
1560_spentry(tcallnfnvsp)
1561        __(ldr(loc_pc,lisp_frame.savelr(sp)))
1562        __(ldr(fn,lisp_frame.savefn(sp)))
1563        __(ldr(vsp,lisp_frame.savevsp(sp)))
1564        __(discard_lisp_frame())
1565        __(mtlr loc_pc)
1566        __(jump_nfn())
1567       
1568_spentry(misc_ref)
1569ifdef([PPC64],[
1570        ],[
1571        __(trap_unless_fulltag_equal(arg_y,fulltag_misc,imm0))
1572        __(trap_unless_lisptag_equal(arg_z,tag_fixnum,imm0))
1573        __(vector_length(imm0,arg_y,imm1))
1574        __(trlge(arg_z,imm0))
1575        __(extract_lowbyte(imm1,imm1))  /* imm1 = subtag */
1576       
1577/* Reference index arg_z of a misc-tagged object (arg_y).
1578   Note that this conses in some cases.  Return a properly-tagged
1579   lisp object in arg_z.  Do type and bounds-checking.
1580*/
1581])       
1582misc_ref_common:
1583ifdef([PPC64],[
1584        ],[       
1585        __(extract_fulltag(imm2,imm1))
1586        __(cmpri(cr0,imm2,fulltag_nodeheader))
1587        __(cmpri(cr1,imm1,max_32_bit_ivector_subtag))
1588        __(cmpri(cr2,imm1,max_8_bit_ivector_subtag))
1589        __(addi imm0,arg_z,misc_data_offset)
1590        __(bne cr0,local_label(ref_imm))
1591        /* A node vector. */
1592        __(ldrx(arg_z,arg_y,imm0))
1593        __(blr)
1594local_label(ref_imm):
1595        __(bgt cr1,local_label(ref_not32))
1596        __(cmpri(cr1,imm1,subtag_single_float_vector))
1597        __(cmpri(cr0,imm1,subtag_s32_vector))
1598        __(ldrx(imm0,arg_y,imm0))
1599        __(beq cr1,local_label(ref_sfloat))
1600        __(beq cr0,local_label(ref_signed))
1601local_label(ref_unsigned):
1602        __(cmpri(cr1,imm0,0))
1603        __(srawi. imm1,imm0,31-nfixnumtagbits)
1604        __(box_fixnum(arg_z,imm0))
1605        __(beqlr+ cr0)
1606        __(li imm1,one_digit_bignum_header)
1607        __(blt cr1,local_label(two_digit))
1608        __(Misc_Alloc_Fixed(arg_z,imm1,8))
1609        __(str(imm0,misc_data_offset(arg_z)))
1610        __(blr)
1611local_label(two_digit):
1612        __(li imm1,two_digit_bignum_header)
1613        __(Misc_Alloc_Fixed(arg_z,imm1,16))
1614        __(str(imm0,misc_data_offset(arg_z)))
1615        __(blr)
1616local_label(ref_signed):
1617        __(addo imm1,imm0,imm0)
1618        __(addo. arg_z,imm1,imm1)
1619        __(bnslr)
1620        __(mtxer rzero)
1621        __(li imm1,one_digit_bignum_header)
1622        __(Misc_Alloc_Fixed(arg_z,imm1,8))
1623        __(str(imm0,misc_data_offset(arg_z)))
1624        __(blr)
1625local_label(ref_sfloat):
1626        __(li imm1,single_float_header)
1627        __(Misc_Alloc_Fixed(arg_z,imm1,single_float.size))
1628        __(str(imm0,single_float.value(arg_z)))
1629        __(blr)
1630local_label(ref_not32):
1631        __(cmpri(cr1,imm1,max_16_bit_ivector_subtag))
1632        __(bgt cr2,local_label(ref_not8))
1633        /* 8-bit objects are either u8, s8, or base_strings. */
1634        /* cr2_eq is set if base_string (= max_8_bit_ivector_subtag) */
1635        __(cmpri(cr1,imm1,subtag_s8_vector))
1636        __(srwi imm0,arg_z,2)
1637        __(la imm0,misc_data_offset(imm0))
1638        __(lbzx imm0,arg_y,imm0)
1639        __(beq cr2,local_label(ref_char))
1640        __(bne cr1,local_label(ref_box))
1641        __(extsb imm0,imm0)
1642local_label(ref_box):   
1643        __(box_fixnum(arg_z,imm0))
1644        __(blr)
1645local_label(ref_char): 
1646        __(slwi arg_z,imm0,charcode_shift)
1647        __(ori arg_z,arg_z,subtag_character)
1648        __(blr)
1649local_label(ref_not8):
1650        __(cmpri(cr2,imm1,subtag_bit_vector))
1651        __(bgt cr1,local_label(ref_not16))
1652        /* 16-bit objects are either u16, s16, or general_strings. */
1653        /* cr1_eq is set if s16_vector (= max_16_bit_ivector_subtag) */
1654        __(cmpri(cr0,imm1,subtag_simple_general_string))
1655        __(srwi imm0,arg_z,1)
1656        __(la imm0,misc_data_offset(imm0))
1657        __(lhzx imm0,arg_y,imm0)
1658        __(beq cr0,local_label(ref_char))
1659        __(bne cr1,local_label(ref_box))
1660        __(extsh imm0,imm0)
1661        __(b local_label(ref_box))
1662local_label(ref_not16):
1663        __(bne cr2,local_label(ref_dfloat))
1664        __(extrwi imm1,arg_z,5,32-(fixnumshift+5))      /* imm1 = bitnum */
1665        __(la imm1,1+fixnumshift(imm1))
1666        __(rlwinm imm0,arg_z,32-5,5,31-fixnumshift)
1667        __(la imm0,misc_data_offset(imm0))
1668        __(ldrx(imm0,arg_y,imm0))
1669        __(rlwnm arg_z,imm0,imm1,31-fixnumshift,31-fixnumshift)
1670        __(blr)
1671local_label(ref_dfloat):
1672        __(slwi imm0,arg_z,1)
1673        __(la imm0,misc_dfloat_offset(imm0))
1674        __(la imm1,4(imm0))
1675        __(ldrx(imm0,arg_y,imm0))
1676        __(ldrx(imm1,arg_y,imm1))
1677        __(li imm2,double_float_header)
1678        __(Misc_Alloc_Fixed(arg_z,imm2,double_float.size))
1679        __(str(imm0,double_float.value(arg_z)))
1680        __(str(imm1,double_float.value+4(arg_z)))
1681        __(blr)
1682])       
1683       
1684       
1685/* misc_set (vector index newval).  Pretty damned similar to
1686   misc_ref, as one might imagine.
1687*/
1688_spentry(misc_set)
1689        __(trap_unless_fulltag_equal(arg_x,fulltag_misc,imm0))
1690        __(trap_unless_lisptag_equal(arg_y,tag_fixnum,imm0))
1691        __(vector_length(imm0,arg_x,imm1))
1692        __(trlge(arg_y,imm0))
1693        __(extract_lowbyte(imm1,imm1))
1694        __(b misc_set_common)
1695       
1696/* Make a cons cell on the vstack.  Always push 3 words, 'cause we're 
1697   not sure how the vstack will be aligned. */
1698_spentry(stkconsyz)
1699        __(li imm0,nil_value)
1700        __(vpush(imm0))
1701        __(vpush(imm0))
1702        __(vpush(imm0))
1703        __(andi. imm0,vsp,1<<word_shift) /* (oddp vsp ?) */
1704        __(beq cr0,1f)
1705        __(str(arg_y,node_size*2(vsp))) /* car */
1706        __(str(arg_z,node_size(vsp))) /* cdr */
1707        __(la arg_z,fulltag_cons+node_size(vsp))
1708        __(blr)
17091:
1710        __(str(arg_y,node_size(vsp))) /* car, again */
1711        __(str(arg_z,0(vsp)))
1712        __(la arg_z,fulltag_cons(vsp))
1713        __(blr)
1714
1715/* Make a stack-consed value cell.  Much like the case of
1716   stack-allocating a cons cell.  Imm0 points to the closed-over value
1717   (already vpushed).  Replace that locative with the vcell. */
1718_spentry(stkvcell0)
1719        __(sub imm1,imm0,vsp) /* imm1 = delta from vsp to value cell loc */
1720        __(li arg_z,nil_value)
1721        __(vpush(arg_z))
1722        __(vpush(arg_z))
1723        __(vpush(arg_z))
1724        __(addi imm1,imm1,12)
1725        __(add imm0,vsp,imm1) /* in case stack overflowed */
1726        __(andi. imm1,vsp,1<<2) /* (oddp vsp) ? */
1727        __(li imm1,value_cell_header)
1728        __(ldr(arg_z,0(imm0)))
1729        __(beq cr0,1f)
1730        __(str(arg_z,8(vsp)))
1731        __(str(imm1,4(vsp)))
1732        __(la arg_z,fulltag_misc+4(vsp))
1733        __(str(arg_z,0(imm0)))
1734        __(blr)
17351:
1736        __(str(arg_z,4(vsp)))
1737        __(str(imm1,0(vsp)))
1738        __(la arg_z,fulltag_misc(vsp))
1739        __(str(arg_z,0(imm0)))
1740        __(blr)
1741
1742       
1743_spentry(stkvcellvsp)     
1744        __(li arg_z,nil_value)
1745        __(vpush(arg_z))
1746        __(vpush(arg_z))
1747        __(vpush(arg_z))
1748        __(li imm1,12)
1749        __(add imm0,vsp,imm1) /* in case stack overflowed */
1750        __(andi. imm1,vsp,1<<2) /* (oddp vsp) ? */
1751        __(li imm1,value_cell_header)
1752        __(ldr(arg_z,0(imm0)))
1753        __(beq cr0,1f)
1754        __(str(arg_z,8(vsp)))
1755        __(str(imm1,4(vsp)))
1756        __(la arg_z,fulltag_misc+4(vsp))
1757        __(str(arg_z,0(imm0)))
1758        __(blr)
17591:
1760        __(str(arg_z,4(vsp)))
1761        __(str(imm1,0(vsp)))
1762        __(la arg_z,fulltag_misc(vsp))
1763        __(str(arg_z,0(imm0)))
1764        __(blr)
1765
1766/* Make a "raw" area on the temp stack, stack-cons a macptr to point to it,
1767   and return the macptr.  Size (in bytes, boxed) is in arg_z on entry; macptr in
1768   arg_z on exit.
1769   It would be nice to cons in the Mac heap if there's not room on
1770   the tstack. This code will handle a new tstack segment being added. */
1771_spentry(makestackblock)
1772        __(unbox_fixnum(imm0,arg_z))
1773        __(dnode_align(imm0,imm0,tsp_frame.fixed_overhead+macptr.size))
1774        __(cmplri(cr0,imm0,tstack_alloc_limit))
1775        __(bge cr0,1f)
1776        __(TSP_Alloc_Var_Unboxed(imm0))
1777        __(li imm0,macptr_header)
1778        __(la imm1,tsp_frame.data_offset+macptr.size(tsp))
1779        __(str(imm0,tsp_frame.data_offset(tsp)))
1780        __(la arg_z,tsp_frame.data_offset+fulltag_misc(tsp))
1781        __(str(imm1,macptr.address(arg_z)))
1782        __(stfd fp_zero,macptr.domain(arg_z))
1783        __(blr)
1784
1785/* Too big. Heap cons a gcable macptr */
17861:
1787        __(TSP_Alloc_Fixed_Unboxed(0))
1788        __(set_nargs(1))
1789        __(li fname,nrs.new_gcable_ptr)
1790        __(jump_fname())
1791
1792/* As above, only set the block's contents to 0. */
1793_spentry(makestackblock0)
1794        __(unbox_fixnum(imm0,arg_z))
1795        __(dnode_align(imm0,imm0,tsp_frame.fixed_overhead+macptr.size))
1796        __(cmplri(cr0,imm0,tstack_alloc_limit))
1797        __(bge cr0,3f)
1798        __(TSP_Alloc_Var_Unboxed(imm0))
1799        __(Zero_TSP_Frame(imm0,imm1))
1800        __(li imm0,macptr_header)
1801        __(la imm1,tsp_frame.data_offset+macptr.size(tsp))
1802        __(str(imm0,tsp_frame.data_offset(tsp)))
1803        __(la arg_z,tsp_frame.data_offset+fulltag_misc(tsp))
1804        __(str(imm1,macptr.address(arg_z))) /* makestackblock0 expects the address to be in imm1 */
1805        __(stfd fp_zero,macptr.domain(arg_z))
1806        __(blr)
1807
1808/* Too big. Heap cons a gcable macptr */
18093:
1810        __(TSP_Alloc_Fixed_Unboxed(0)) /* "raw" block to make the compiler happy */
1811
1812        __(mr arg_y,arg_z) /* save block size */
1813        __(li arg_z,t_value) /* clear-p arg to %new-gcable-ptr */
1814        __(set_nargs(2))
1815        __(li fname,nrs.new_gcable_ptr)
1816        __(jump_fname())
1817
1818/* Make a list of length arg_y (boxed), initial-element arg_z (boxed) on
1819   the tstack.  Return the list in arg_z. */
1820_spentry(makestacklist)
1821        __(add imm0,arg_y,arg_y)
1822        __(cmplri(cr1,imm0,((tstack_alloc_limit+1)-8)))
1823        __(addi imm0,imm0,tsp_frame.fixed_overhead)
1824        __(bge cr1,3f)
1825        __(TSP_Alloc_Var_Boxed(imm0,imm1))
1826        __(mr imm1,arg_y)
1827        __(cmpri(cr1,imm1,0))
1828        __(mr arg_y,arg_z)
1829        __(li arg_z,nil_value)
1830        __(ldr(imm2,tsp_frame.backlink(tsp)))
1831        __(la imm2,-tsp_frame.fixed_overhead+fulltag_cons(imm2))
1832        __(b 2f)
18331:
1834        __(subi imm1,imm1,fixnum1)
1835        __(cmpri(cr1,imm1,0))
1836        __(rplacd(imm2,arg_z))
1837        __(rplaca(imm2,arg_y))
1838        __(mr arg_z,imm2)
1839        __(subi imm2,imm2,cons.size)
18402:
1841        __(bne cr1,1b)
1842        __(blr)
1843
18443:
1845        __(cmpri(cr1,arg_y,0))
1846        __(TSP_Alloc_Fixed_Boxed(0))  /* make the compiler happy */
1847        __(mr imm1,arg_y) /* count */
1848        __(mr arg_y,arg_z) /* initial value */
1849        __(li arg_z,nil_value) /* result */
1850        __(b 5f)
18514:
1852        __(subi imm1,imm1,fixnum1)
1853        __(cmpri(cr1,imm1,0))
1854        __(Cons(arg_z,arg_y,arg_z))
18555:
1856        __(bne cr1,4b)
1857        __(blr)
1858
1859/* subtype (boxed) vpushed before initial values. (Had better be a
1860        node header subtag.) Nargs set to count of things vpushed. */
1861
1862_spentry(stkgvector)
1863        __(la imm0,-fixnum_one(nargs))
1864        __(cmpri(cr1,imm0,0))
1865        __(add imm1,vsp,nargs)
1866        __(ldru(temp0,-node_size(imm1)))
1867        __(slwi imm2,imm0,num_subtag_bits-fixnumshift)
1868        __(rlwimi imm2,temp0,32-fixnumshift,32-num_subtag_bits,31)
1869        __(dnode_align(imm0,imm0,node_size+tsp_frame.fixed_overhead))
1870        __(TSP_Alloc_Var_Boxed_nz(imm0,imm3))
1871        __(str(imm2,tsp_frame.data_offset(tsp)))
1872        __(la arg_z,tsp_frame.data_offset+fulltag_misc(tsp))
1873        __(la imm3,misc_header_offset(arg_z))
1874        __(li imm0,fixnum1)
1875        __(b 2f)
18761:
1877        __(addi imm0,imm0,fixnum1)
1878        __(cmpr(cr1,imm0,nargs))
1879        __(ldru(temp0,-node_size(imm1)))
1880        __(stru(temp0,node_size(imm3)))
18812:
1882        __(bne cr1,1b)
1883        __(add vsp,vsp,nargs)
1884        __(blr)
1885
1886/* Allocate a "fulltag_misc" object.  On entry, arg_y contains the element */
1887/* count (boxed) and  arg_z contains the subtag (boxed).  Both of these  */
1888/* parameters must be "reasonable" (the  subtag must be valid, the element */
1889/* count must be of type (unsigned-byte 24).  */
1890/* On exit, arg_z contains the (properly tagged) misc object; it'll have a */
1891/* proper header on it and its contents will be 0.   imm0 contains  */
1892/* the object's header (fulltag = fulltag_immheader or fulltag_nodeheader.) */
1893/* This is intended for things like "make-array" and "%make-bignum" and the  */
1894/* like.  Things that involve creating small objects of known size can usually */
1895/* do so inline with less hair. */
1896
1897/* If this has to go out-of-line (to GC or whatever), it should do so via a  */
1898/* trap (or should otherwise ensure that both the LR and CTR are preserved  */
1899/* where the GC can find them.) */
1900
1901
1902_spentry(misc_alloc)
1903ifdef([PPC64],[
1904        ],[       
1905        __(extract_unsigned_byte_bits_(imm2,arg_y,24))
1906        __(unbox_fixnum(imm0,arg_z))
1907        __(extract_fulltag(imm1,imm0))
1908        __(bne- cr0,9f)
1909        __(cmpri(cr0,imm1,fulltag_nodeheader))
1910        __(mr imm3,imm0)
1911        __(cmplri(cr1,imm0,max_32_bit_ivector_subtag))
1912        __(rlwimi imm0,arg_y,num_subtag_bits-fixnum_shift,0,31-num_subtag_bits  /* imm0 now = header */)
1913        __(mr imm2,arg_y)
1914        __(beq cr0,1f)  /* do probe if node object (fixnum element count = byte count). */
1915        __(cmplri(cr0,imm3,max_16_bit_ivector_subtag))
1916        __(bng cr1,1f)  /* do probe if 32-bit imm object */
1917        __(cmplri(cr1,imm3,max_8_bit_ivector_subtag))
1918        __(srwi imm2,imm2,1)
1919        __(bgt cr0,2f)
1920        __(bgt cr1,1f)
1921        __(srwi imm2,imm2,1)
1922/* imm2 now = byte count.  Add 4 for header, 7 to align, then clear low three bits. */
19231:
1924        __(dnode_align(imm2,imm2,node_size))
1925
1926        __(Misc_Alloc(arg_z,imm0,imm2))
1927        __(blr)
19282:
1929        __(cmplri(imm3,subtag_double_float_vector))
1930        __(slwi imm2,arg_y,1)
1931        __(beq 1b)
1932        __(addi imm2,arg_y,7<<fixnumshift)
1933        __(srwi imm2,imm2,fixnumshift+3)
1934        __(b 1b)
19359:
1936        __(uuo_interr(error_object_not_unsigned_byte_24,arg_y))
1937])       
1938       
1939/* almost exactly as above, but "swap exception handling info"
1940   on exit and return */
1941_spentry(ffcallX)
1942        __(mflr loc_pc)
1943        __(vpush_saveregs())            /* Now we can use save0-save7 to point to stacks */
1944        __(mr save0,rcontext)   /* or address globals. */
1945        __(extract_typecode(imm0,arg_z))
1946        __(cmpri(cr7,imm0,subtag_macptr))
1947        __(ldr(save1,c_frame.backlink(sp)))     /* bottom of reserved lisp frame */
1948        __(la save2,-lisp_frame.size(save1))    /* top of lisp frame*/
1949        __(zero_doublewords save2,0,lisp_frame.size)
1950        __(str(save1,lisp_frame.backlink(save2)))
1951        __(str(save2,c_frame.backlink(sp)))
1952        __(str(fn,lisp_frame.savefn(save2)))
1953        __(str(loc_pc,lisp_frame.savelr(save2)))
1954        __(str(vsp,lisp_frame.savevsp(save2)))
1955        __(bne cr7,1f)
1956        __(ldr(arg_z,macptr.address(arg_z)))
19571:
1958        __(ldr(save3,tcr.cs_area(rcontext)))
1959        __(str(save2,area.active(save3)))
1960        __(str(allocptr,tcr.save_allocptr(rcontext)))
1961        __(str(allocbase,tcr.save_allocbase(rcontext)))
1962        __(str(tsp,tcr.save_tsp(rcontext)))
1963        __(str(vsp,tcr.save_vsp(rcontext)))
1964        __(str(rzero,tcr.ffi_exception(rcontext)))
1965        __(mffs f0)
1966        __(stfd f0,tcr.lisp_fpscr(rcontext))    /* remember lisp's fpscr */
1967        __(mtfsf 0xff,fp_zero)  /* zero foreign fpscr */
1968        __(ldr(r3,tcr.foreign_exception_status(rcontext)))
1969        __(cmpri(r3,0))
1970        __(ref_global(r12,lisp_exit_hook))
1971        __(mtctr r12)
1972        __(beq+ 1f)
1973        __(stru(sp,-(stack_align(c_frame.minsiz))(sp)))
1974        __(bctrl)
1975        __(la sp,(stack_align(c_frame.minsiz))(sp))
19761:     
1977        __(li rcontext,0)
1978        __(mtctr arg_z)
1979        __(ldr(r3,c_frame.param0(sp)))
1980        __(ldr(r4,c_frame.param1(sp)))
1981        __(ldr(r5,c_frame.param2(sp)))
1982        __(ldr(r6,c_frame.param3(sp)))
1983        __(ldr(r7,c_frame.param4(sp)))
1984        __(ldr(r8,c_frame.param5(sp)))
1985        __(ldr(r9,c_frame.param6(sp)))
1986        __(ldr(r10,c_frame.param7(sp)))
1987        /* Darwin is allegedly very picky about what register points
1988           to the function on entry. */
1989        __(mr r12,arg_z)
1990        __(bctrl)
1991        __(ref_global(r12,lisp_return_hook))
1992        __(mtctr r12)
1993        __(str(r3,c_frame.param0(sp)))
1994        __(str(r4,c_frame.param1(sp)))
1995        __(stfd f1,c_frame.param2(sp))
1996        __(stru(sp,-(stack_align(c_frame.minsiz))(sp)))
1997        __(mr r3,save0)
1998        __(bctrl)
1999        __(la sp,(stack_align(c_frame.minsiz))(sp))
2000        __(ldr(r3,c_frame.param0(sp)))
2001        __(ldr(r4,c_frame.param1(sp)))
2002        __(lfd f1,c_frame.param2(sp))
2003        __(b _local_label(FF_call_return_common))       
2004       
2005/* Bind special symbol in arg_z to its current value. */
2006_spentry(bind_self_boundp_check)
2007        __(ldr(imm0,symbol.flags(arg_z)))
2008        __(andi. imm0,imm0,sym_vbit_bound_mask)
2009        __(mr arg_y,arg_z)
2010        __(ldr(imm2,tcr.db_link(rcontext)))
2011        __(cmpri(cr1,imm2,0))
2012        __(beq 8f)
2013        __(b 1f)
20140:      __(mr imm1,imm2)
2015        __(ldr(temp0,binding.sym(imm1)))
2016        __(cmpr(temp0,arg_y))
2017        __(ldr(imm2,binding.link(imm1)))
2018        __(cmpri(cr1,imm2,0))
2019        __(bne 1f)
2020        __(ldr(arg_z,binding.val(imm1)))
2021        __(b 9f)
20221:      __(bne cr1,0b)
20238:      __(ldr(arg_z,symbol.vcell(arg_y)))
20249:      __(treqi(arg_z,unbound_marker))
2025        __(ldr(imm0,symbol.flags(arg_y)))
2026        __(ori imm0,imm0,sym_vbit_bound_mask)
2027        __(ldr(imm1,tcr.db_link(rcontext)))
2028        __(vpush(arg_z))
2029        __(vpush(arg_y))
2030        __(vpush(imm1))
2031        __(str(vsp,tcr.db_link(rcontext)))
2032        __(str(imm0,symbol.flags(arg_y)))
2033        __(blr)
2034
2035/* Destructuring-bind, macro-bind.
2036   */
2037/* OK to use arg_x, arg_y for whatever (tagged) purpose; 
2038   likewise immX regs.
2039   arg_z preserved, nothing else in particular defined on exit.
2040   nargs contains req count (0-255) in PPC bits mask_req_start/mask_req_width, 
2041                  opt count (0-255) in PPC bits mask_opt_start/mask_opt_width, 
2042                  key count (0-255) in PPC bits mask_key_start/mask_key_width, 
2043                  opt-supplied-p flag in PPC bit mask_initopt, 
2044                  keyp flag in PPC bit mask_keyp, 
2045                  &allow-other-keys flag in PPC bit mask_aok, 
2046                   &rest flag in PPC bit mask_restp.
2047   When mask_keyp bit is set, keyvect contains vector of keyword symbols, 
2048        length key count. */
2049
2050_spentry(macro_bind)
2051ifdef([PPC64],[
2052        ],[       
2053        __(mr whole_reg,arg_reg)
2054        __(extract_lisptag(imm0,arg_reg))
2055        __(cmpri(cr0,imm0,tag_list))
2056        __(bne- cr0,1f)
2057        __(_cdr(arg_reg,arg_reg))
2058        __(b destbind1)
20591:
2060        __(li arg_y,XCALLNOMATCH)
2061        __(mr arg_z,whole_reg)
2062        __(set_nargs(2))
2063        __(b _SPksignalerr)
2064])
2065
2066_spentry(destructuring_bind)
2067        __(mr whole_reg,arg_reg)
2068        __(b destbind1)
2069       
2070_spentry(destructuring_bind_inner)
2071        __(mr whole_reg,arg_z)
2072destbind1:
2073ifdef([PPC64],[
2074        ],[
2075        /* Extract required arg count. */
2076         /* A bug in gas: can't handle shift count of "32" (= 0 */
2077        ifelse(eval(mask_req_width+mask_req_start),eval(32),[
2078        __(clrlwi. imm0,nargs,mask_req_start)
2079        ],[
2080        __(extrwi. imm0,nargs,mask_req_width,mask_req_start)
2081        ])
2082        __(extrwi imm1,nargs,mask_opt_width,mask_opt_start)
2083        __(rlwinm imm2,nargs,0,mask_initopt,mask_initopt)
2084        __(rlwinm imm4,nargs,0,mask_keyp,mask_keyp)
2085        __(cmpri(cr4,imm4,0))
2086        __(rlwinm imm4,nargs,0,mask_restp,mask_restp)
2087        __(cmpri(cr5,imm4,0))
2088        __(cmpri(cr1,imm1,0))
2089        __(cmpri(cr2,imm2,0))
2090        /* Save entry vsp in case of error. */
2091        __(mr imm4,vsp)
2092        __(beq cr0,2f)
20931:
2094        __(cmpri(cr7,arg_reg,nil_value))
2095        __(extract_lisptag(imm3,arg_reg))
2096        __(cmpri(cr3,imm3,tag_list))
2097        __(subi imm0,imm0,1)
2098        __(cmpri(cr0,imm0,0))
2099        __(beq cr7,toofew)
2100        __(bne cr3,badlist)
2101        __(ldr(arg_x,cons.car(arg_reg)))
2102        __(ldr(arg_reg,cons.cdr(arg_reg)))
2103        __(vpush(arg_x))
2104        __(bne cr0,1b)
21052:
2106        __(beq cr1,rest_keys)
2107        __(bne cr2,opt_supp)
2108        /* 'simple' &optionals:  no supplied-p, default to nil. */
2109simple_opt_loop:
2110        __(cmpri(cr0,arg_reg,nil_value))
2111        __(extract_lisptag(imm3,arg_reg))
2112        __(cmpri(cr3,imm3,tag_list))
2113        __(subi imm1,imm1,1)
2114        __(cmpri(cr1,imm1,0))
2115        __(li imm5,nil_value)
2116        __(beq cr0,default_simple_opt)
2117        __(bne cr3,badlist)
2118        __(ldr(arg_x,cons.car(arg_reg)))
2119        __(ldr(arg_reg,cons.cdr(arg_reg)))
2120        __(vpush(arg_x))
2121        __(bne cr1,simple_opt_loop)
2122        __(b rest_keys)
2123default_simple_opt_loop:
2124        __(subi imm1,imm1,1)
2125        __(cmpri(cr1,imm1,0))
2126default_simple_opt:
2127        __(vpush(imm5))
2128        __(bne cr1,default_simple_opt_loop)
2129        __(b rest_keys)
2130        /* Provide supplied-p vars for the &optionals. */
2131opt_supp:
2132        __(li arg_y,t_value)
2133opt_supp_loop:
2134        __(cmpri(cr0,arg_reg,nil_value))
2135        __(extract_lisptag(imm3,arg_reg))
2136        __(cmpri(cr3,imm3,tag_list))
2137        __(subi imm1,imm1,1)
2138        __(cmpri(cr1,imm1,0))
2139        __(beq cr0,default_hard_opt)
2140        __(bne cr3,badlist)
2141        __(ldr(arg_x,cons.car(arg_reg)))
2142        __(ldr(arg_reg,cons.cdr(arg_reg)))
2143        __(vpush(arg_x))
2144        __(vpush(arg_y))
2145        __(bne cr1,opt_supp_loop)
2146        __(b rest_keys)
2147default_hard_opt_loop:
2148        __(subi imm1,imm1,1)
2149        __(cmpri(cr1,imm1,0))
2150default_hard_opt:
2151        __(vpush(imm5))
2152        __(vpush(imm5))
2153        __(bne cr1,default_hard_opt_loop)
2154rest_keys:
2155        __(cmpri(cr0,arg_reg,nil_value))
2156        __(bne cr5,have_rest)
2157        __(bne cr4,have_keys)
2158        __(bne cr0,toomany)
2159        __(blr)
2160have_rest:
2161        __(vpush(arg_reg))
2162        __(beqlr cr4)
2163have_keys:
2164        /* Ensure that arg_reg contains a proper,even-length list. */
2165        /* Insist that its length is <= 512 (as a cheap circularity check.) */
2166        __(li imm0,256)
2167        __(mr arg_x,arg_reg)
2168count_keys_loop:
2169        __(extract_lisptag(imm3,arg_x))
2170        __(cmpri(cr3,imm3,tag_list))
2171        __(cmpri(cr0,arg_x,nil_value))
2172        __(subi imm0,imm0,1)
2173        __(cmpri(cr4,imm0,0))
2174        __(bne cr3,badlist)
2175        __(beq cr0,counted_keys)
2176        __(ldr(arg_x,cons.cdr(arg_x)))
2177        __(extract_lisptag(imm3,arg_x))
2178        __(cmpri(cr3,imm3,tag_list))
2179        __(blt cr4,toomany)
2180        __(cmpri(cr0,arg_x,nil_value))
2181        __(bne cr3,badlist)
2182        __(beq cr0,db_badkeys)
2183        __(ldr(arg_x,cons.cdr(arg_x)))
2184        __(b count_keys_loop)
2185counted_keys:
2186        /*
2187          We've got a proper, even-length list of key/value pairs in
2188        arg_reg. For each keyword var in the lambda-list, push a pair
2189        of NILs on the vstack. */
2190        __(extrwi. imm0,nargs,mask_key_width,mask_key_start )
2191        __(mr imm2,imm0)        /* save number of keys */
2192        __(li imm5,nil_value)
2193        __(b push_pair_test)
2194push_pair_loop:
2195        __(cmpri(cr0,imm0,1))
2196        __(subi imm0,imm0,1)
2197        __(vpush(imm5))
2198        __(vpush(imm5))
2199push_pair_test:
2200        __(bne cr0,push_pair_loop)
2201        __(slwi imm2,imm2,3)            /* pairs -> bytes */
2202        __(add imm2,vsp,imm2)           /* imm2 points below pairs */
2203        __(li imm0,0)                   /* count unknown keywords so far */
2204        __(extrwi imm1,nargs,1,mask_aok) /* unknown keywords allowed */
2205        __(extrwi nargs,nargs,mask_key_width,mask_key_start)
2206        /* Now, for each keyword/value pair in the list */
2207        /*  a) if the keyword is found in the keyword vector, set the */
2208        /*     corresponding entry on the vstack to the value and the */
2209        /*     associated supplied-p var to T. */
2210        /*  b) Regardless of whether or not the keyword is found, */
2211        /*     if the keyword is :ALLOW-OTHER-KEYS and the value is non-nil, */
2212        /*     set imm1 to a non-zero value to indicate that unknown keywords */
2213        /*     are acceptable. */
2214        /*  c) If the keyword is not found (and isn't :ALLOW-OTHER-KEYS), increment */
2215        /*     the count of unknown keywords in imm0. */
2216        /* At the end of the list, signal an error if any unknown keywords were seen */
2217        /* but not allowed.  Otherwise, return. */
2218
2219match_keys_loop:
2220        __(cmpri(cr0,arg_reg,nil_value))
2221        __(li imm0,0)
2222        __(li imm3,misc_data_offset)
2223        __(beq cr0,matched_keys)
2224        __(ldr(arg_x,cons.car(arg_reg)))
2225        __(li arg_y,nrs.kallowotherkeys)
2226        __(cmpr(cr3,arg_x,arg_y))       /* :ALLOW-OTHER-KEYS ? */
2227        __(ldr(arg_reg,cons.cdr(arg_reg)))
2228        __(ldr(arg_y,cons.car(arg_reg)))
2229        __(cmpri(cr0,arg_y,nil_value))
2230        __(cmpr(cr4,imm0,nargs))
2231        __(ldr(arg_reg,cons.cdr(arg_reg)))
2232        __(bne cr3,match_test)
2233        __(beq cr0,match_test)
2234        __(ori imm1,imm1,1)
2235        __(b match_test)
2236match_loop:
2237        __(ldrx(temp0,keyvect_reg,imm3))
2238        __(cmpr(cr0,arg_x,temp0))
2239        __(addi imm0,imm0,1)
2240        __(cmpr(cr4,imm0,nargs))
2241        __(addi imm3,imm3,4)
2242        __(bne cr0,match_test)
2243        /* Got a hit.  Unless this keyword's been seen already, set it. */
2244        __(slwi imm0,imm0,3)
2245        __(subf imm0,imm0,imm2)
2246        __(ldr(temp0,0(imm0)))
2247        __(cmpri(cr0,temp0,nil_value))
2248        __(li temp0,t_value)
2249        __(bne cr0,match_keys_loop)     /* already saw this */
2250        __(str(arg_y,node_size*1(imm0)))
2251        __(str(temp0,node_size*2(imm0)))
2252        __(b match_keys_loop)
2253match_test:
2254        __(bne cr4,match_loop)
2255        __(oris imm1,imm1,0x8000)
2256        __(b match_keys_loop)
2257matched_keys:
2258        __(cmpri(cr1,imm1,0))
2259        __(add imm1,imm1,imm1)
2260        __(cmpri(cr0,imm1,0))
2261        __(bgelr cr1)
2262        __(bnelr cr0)
2263        /* Some unrecognized keywords.  Complain generically about */
2264        /* invalid keywords. */
2265db_badkeys:
2266        __(li arg_y,XBADKEYS)
2267        __(b destructure_error)
2268toomany:
2269        __(li arg_y,XCALLTOOMANY)
2270        __(b destructure_error)
2271toofew:
2272        __(li arg_y,XCALLTOOFEW)
2273        __(b destructure_error)
2274badlist:
2275        __(li arg_y,XCALLNOMATCH)
2276        /* b destructure_error */
2277destructure_error:
2278        __(mr vsp,imm4)         /* undo everything done to the stack */
2279        __(mr arg_z,whole_reg)
2280        __(set_nargs(2))
2281        __(b _SPksignalerr)
2282])     
2283/* vpush the values in the value set atop the vsp, incrementing nargs. */
2284/* Discard the tsp frame; leave values atop the vsp. */
2285
2286_spentry(recover_values)
2287
2288/* First, walk the segments reversing the pointer to previous segment pointers */
2289/* Can tell the end because that previous segment pointer is the prev tsp pointer */
2290        __(ldr(imm0,tsp_frame.backlink(tsp))) /* previous tsp */
2291        __(mr imm1,tsp) /* current segment */
2292        __(mr imm2,tsp) /* last segment */
2293local_label(walkloop):
2294        __(ldr(imm3,tsp_frame.fixed_overhead+node_size(imm1))) /* next segment */
2295        __(cmpr(cr0,imm0,imm3)) /* last segment? */
2296        __(str(imm2,tsp_frame.fixed_overhead+node_size(imm1))) /* reverse pointer */
2297        __(mr imm2,imm1) /* last segment <- current segment */
2298        __(mr imm1,imm3) /* current segment <- next segment */
2299        __(bne cr0,local_label(walkloop))
2300
2301/* the final segment ptr is now in imm2 */
2302/* walk backwards, pushing values on VSP and incrementing NARGS */
2303local_label(pushloop):
2304        __(ldr(imm0,tsp_frame.data_offset(imm2))) /* nargs in segment */
2305        __(cmpri(cr0,imm0,0))
2306        __(cmpr(cr1,imm2,tsp))
2307        __(la imm3,tsp_frame.data_offset+(2*node_size)(imm2))
2308        __(add imm3,imm3,imm0)
2309        __(add nargs,nargs,imm0)
2310        __(b 2f)
23111:
2312        __(ldru(arg_z,-node_size(imm3)))
2313        __(cmpri(cr0,imm0,fixnum_one))
2314        __(subi imm0,imm0,fixnum_one)
2315        __(vpush(arg_z))
23162:
2317        __(bne cr0,1b)
2318        __(ldr(imm2,tsp_frame.data_offset+node_size(imm2))) /* previous segment */
2319        __(bne cr1,local_label(pushloop))
2320        __(unlink(tsp))
2321        __(blr)
2322
2323       
2324/* Go out of line to do this.  Sheesh. */
2325
2326_spentry(vpopargregs)
2327        __(cmpri(cr0,nargs,0))
2328        __(cmpri(cr1,nargs,2<<fixnumshift))
2329        __(beqlr cr0)
2330        __(beq cr1,local_label(yz))
2331        __(blt cr1,local_label(z))
2332        __(ldr(arg_z,node_size*0(vsp)))
2333        __(ldr(arg_y,node_size*1(vsp)))
2334        __(ldr(arg_x,node_size*2(vsp)))
2335        __(la vsp,node_size*3(vsp))
2336        __(blr)
2337local_label(yz):
2338        __(ldr(arg_z,node_size*0(vsp)))
2339        __(ldr(arg_y,node_size*1(vsp)))
2340        __(la vsp,node_size*2(vsp))
2341        __(blr)
2342local_label(z):
2343        __(ldr(arg_z,node_size*0(vsp)))
2344        __(la vsp,node_size*1(vsp))
2345        __(blr)
2346
2347/* If arg_z is an integer, return in imm0 something whose sign */
2348/* is the same as arg_z's.  If not an integer, error. */
2349_spentry(integer_sign)
2350        __(extract_typecode(imm0,arg_z))
2351        __(cmpri(cr1,imm0,tag_fixnum))
2352        __(cmpri(cr0,imm0,subtag_bignum))
2353        __(mr imm0,arg_z)
2354        __(beqlr+ cr1)
2355        __(bne- cr0,1f)
2356        __(getvheader(imm0,arg_z))
2357        __(header_length(imm0,imm0)) /* boxed length = scaled size */
2358        __(addi imm0,imm0,misc_data_offset-4) /* bias, less 1 element */
2359        __(ldrx(imm0,arg_z,imm0))
2360        __(cmpri(cr0,imm0,0))
2361        __(li imm0,1)
2362        __(bgelr cr0)
2363        __(li imm0,-1)
2364        __(blr)
23651:
2366        __(uuo_interr(error_object_not_integer,arg_z))
2367
2368/* like misc_set, only pass the (boxed) subtag in temp0 */
2369_spentry(subtag_misc_set)
2370ifdef([PPC64],[
2371],[               
2372        __(trap_unless_fulltag_equal(arg_x,fulltag_misc,imm0))
2373        __(trap_unless_lisptag_equal(arg_y,tag_fixnum,imm0))
2374        __(vector_length(imm0,arg_x,imm1))
2375        __(trlge(arg_y,imm0))
2376        __(unbox_fixnum(imm1,temp0))
2377])       
2378misc_set_common:
2379        ifdef([PPC64],[
2380        ],[
2381        __(extract_fulltag(imm2,imm1))
2382        __(cmpri(cr0,imm2,fulltag_nodeheader))
2383        __(cmpri(cr1,imm1,max_32_bit_ivector_subtag))
2384        __(cmpri(cr2,imm1,max_8_bit_ivector_subtag))
2385        __(addi imm0,arg_y,misc_data_offset)
2386        __(bne cr0,local_label(set_imm))
2387        /* A node vector. */
2388        __(strx(arg_z,arg_x,imm0))
2389        __(blr)
2390local_label(set_imm):
2391        __(extract_lisptag(imm2,arg_z))
2392        __(cmpri(cr7,imm2,tag_misc))
2393        __(cmpri(cr6,imm2,tag_imm))
2394        __(cmpri(cr5,imm2,tag_fixnum))
2395        __(bgt cr1,local_label(set_not32))
2396        __(cmpri(cr1,imm1,subtag_single_float_vector))
2397        __(cmpri(cr0,imm1,subtag_s32_vector))
2398        __(beq cr1,local_label(set_sfloat))
2399        __(beq cr0,local_label(set_signed))
2400        /* Either a non-negative fixnum, a one-digit bignum, or a two-digit */
2401        /* bignum whose sign-digit is 0 is ok. */
2402        __(srawi. imm1,arg_z,fixnum_shift)
2403        __(bne cr5,local_label(set_not_fixnum_u32))
2404        __(blt- cr0,local_label(set_bad))
2405local_label(set_set32):
2406        __(strx(imm1,arg_x,imm0))
2407        __(blr)
2408local_label(set_not_fixnum_u32):
2409        __(bne cr7,local_label(set_bad))
2410        __(extract_header(imm2,arg_z))
2411        __(cmpri(cr0,imm2,one_digit_bignum_header))
2412        __(cmpri(cr1,imm2,two_digit_bignum_header))
2413        __(vrefr(imm1,arg_z,0))
2414        __(cmpri(cr2,imm1,0))
2415        __(bne cr0,local_label(set_not_1_digit))
2416        __(bge cr2,local_label(set_set32))
2417        __(b local_label(set_bad))
2418local_label(set_not_1_digit):
2419        __(bne- cr1,local_label(set_bad))
2420        __(vrefr(imm2,arg_z,1))
2421        __(cmpri(cr0,imm2,0))
2422        __(bne- cr1,local_label(set_bad))
2423        __(beq cr0,local_label(set_set32))
2424local_label(set_bad):
2425        /* arg_z does not match the array-element-type of arg_x. */
2426        __(mr arg_y,arg_z)
2427        __(mr arg_z,arg_x)
2428        __(li arg_x,XNOTELT)
2429        __(set_nargs(3))
2430        __(b _SPksignalerr)
2431local_label(set_signed):
2432        __(unbox_fixnum(imm1,arg_z))
2433        __(beq cr5,local_label(set_set32))
2434        __(bne cr7,local_label(set_bad))
2435        __(extract_header(imm2,arg_z))
2436        __(cmpri(cr0,imm2,one_digit_bignum_header))
2437        __(vrefr(imm1,arg_z,0))
2438        __(bne- cr0,local_label(set_bad))
2439        __(strx(imm1,arg_x,imm0))
2440        __(blr)
2441local_label(set_sfloat):
2442        __(bne- cr7,local_label(set_bad))
2443        __(extract_header(imm2,arg_z))
2444        __(cmpri(cr0,imm2,single_float_header))
2445        __(bne- cr0,local_label(set_bad))
2446        __(ldr(imm1,single_float.value(arg_z)))
2447        __(strx(imm1,arg_x,imm0))
2448        __(blr)
2449       
2450local_label(set_not32):
2451        __(cmpri(cr1,imm1,max_16_bit_ivector_subtag))
2452        __(bgt cr2,local_label(set_not8))
2453        /* 8-bit objects are either u8, s8, or base_strings. */
2454        /* cr2_eq is set if base_string (= max_8_bit_ivector_subtag) */
2455        __(cmpri(cr1,imm1,subtag_s8_vector))
2456        __(extract_lisptag(imm2,arg_z))
2457        __(srwi imm0,arg_y,2)
2458        __(la imm0,misc_data_offset(imm0))
2459        __(extract_unsigned_byte_bits_(imm1,arg_z,8))
2460        __(beq cr2,local_label(set_char8))
2461        __(beq cr1,local_label(set_signed8))
2462        __(unbox_fixnum(imm1,arg_z))
2463        __(bne- cr0,local_label(set_bad))
2464        __(stbx imm1,arg_x,imm0)
2465        __(blr)
2466local_label(set_char8):
2467        __(extract_lowbyte(imm2,arg_z))
2468        __(cmpri(cr2,imm2,subtag_character))
2469        __(srwi imm1,arg_z,charcode_shift)
2470        __(bne- cr2,local_label(set_bad))
2471        __(stbx imm1,arg_x,imm0)
2472        __(blr)
2473local_label(set_signed8):
2474        __(unbox_fixnum(imm1,arg_z))
2475        __(extsb imm2,imm1)
2476        __(cmpr(cr0,imm2,imm1))
2477        __(bne- cr5,local_label(set_bad))
2478        __(bne- cr0,local_label(set_bad))
2479        __(stbx imm1,arg_x,imm0)
2480        __(blr)
2481local_label(set_not8):
2482        __(cmpri(cr2,imm1,subtag_bit_vector))
2483        __(bgt cr1,local_label(set_not16))
2484/* 16-bit objects are either u16, s16, or general_strings. */
2485/* cr1_eq is set if s16_vector (= max_16_bit_ivector_subtag) */
2486        __(cmpri(cr0,imm1,subtag_simple_general_string))
2487        __(srwi imm0,arg_y,1)
2488        __(la imm0,misc_data_offset(imm0))
2489        __(beq cr1,local_label(set_s16))
2490        __(beq cr0,local_label(set_char16))
2491        __(extract_unsigned_byte_bits_(imm1,arg_z,16))
2492        __(unbox_fixnum(imm1,arg_z))
2493        __(bne- cr0,local_label(set_bad))
2494        __(sthx imm1,arg_x,imm0)
2495        __(blr)
2496local_label(set_s16):
2497        __(unbox_fixnum(imm1,arg_z))
2498        __(extsh imm2,imm1)
2499        __(cmpr(cr0,imm2,imm1))
2500        __(bne- cr5,local_label(set_bad))
2501        __(bne- cr0,local_label(set_bad))
2502        __(sthx imm1,arg_x,imm0)
2503        __(blr)
2504local_label(set_char16):
2505        __(extract_lowbyte(imm2,arg_z))
2506        __(cmpri(cr0,imm2,subtag_character))
2507        __(srwi imm1,arg_z,charcode_shift)
2508        __(bne- cr0,local_label(set_bad))
2509        __(sthx imm1,arg_x,imm0)
2510        __(blr)
2511local_label(set_not16):
2512        __(bne cr2,local_label(set_dfloat))
2513        /* Bit vector case. */
2514        __(cmplri(cr2,arg_z,fixnumone))   /* nothing not a (boxed) bit  */
2515        __(extrwi imm1,arg_y,5,32-(fixnumshift+5))      /* imm1 = bitnum */
2516        __(extlwi imm2,arg_z,1,31-fixnumshift)
2517        __(srw imm2,imm2,imm1)
2518        __(lis imm3,0x8000)
2519        __(rlwinm imm0,arg_y,32-5,5,31-fixnumshift)
2520        __(la imm0,misc_data_offset(imm0))
2521        __(srw imm3,imm3,imm1)
2522        __(bgt- cr2,local_label(set_bad))
2523        __(ldrx(imm1,arg_x,imm0))
2524        __(andc imm1,imm1,imm3)
2525        __(or imm1,imm1,imm2)
2526        __(strx(imm1,arg_x,imm0))
2527        __(blr)
2528
2529local_label(set_dfloat):
2530        __(bne- cr7,local_label(set_bad))               /* not tag_misc */
2531        __(extract_header(imm2,arg_z))
2532        __(cmpri(cr0,imm2,double_float_header))
2533        __(slwi imm0,arg_y,1)  /* imm0 gets index * 2 */
2534        __(la imm0,misc_dfloat_offset(imm0)) /* + offset */
2535        __(bne- cr0,local_label(set_bad))
2536        __(ldr(imm1,double_float.value(arg_z))) /* get value parts */
2537        __(ldr(imm2,double_float.value+4(arg_z)))
2538        __(strx(imm1,arg_x,imm0))
2539        __(la imm0,4(imm0))
2540        __(strx(imm2,arg_x,imm0))
2541        __(blr)
2542])       
2543
2544/* "spread" the lexpr in arg_z.
2545   ppc2-invoke-fn assumes that temp1 is preserved here. */
2546_spentry(spread_lexprz)
2547        __(ldr(imm0,0(arg_z)))
2548        __(cmpri(cr3,imm0,3<<fixnumshift))
2549        __(cmpri(cr4,imm0,2<<fixnumshift))
2550        __(add imm1,arg_z,imm0)
2551        __(cmpri(cr0,imm0,0))
2552        __(add nargs,nargs,imm0)
2553        __(cmpri(cr1,nargs,0))
2554        __(cmpri(cr2,nargs,2<<fixnumshift))
2555        __(la imm1,node_size(imm1))
2556        __(bge cr3,9f)
2557        __(beq cr4,2f)
2558        __(bne cr0,1f)
2559        /* lexpr count was 0; vpop the arg regs that */
2560        /* were vpushed by the caller */
2561        __(beqlr cr1)
2562        __(vpop(arg_z))
2563        __(bltlr cr2)
2564        __(vpop(arg_y))
2565        __(beqlr cr2)
2566        __(vpop(arg_x))
2567        __(blr)
2568
2569        /* vpush args from the lexpr until we have only */
2570        /* three left, then assign them to arg_x, arg_y, */
2571        /* and arg_z. */
25728:
2573        __(cmpri(cr3,imm0,4<<fixnumshift))
2574        __(subi imm0,imm0,fixnumone)
2575        __(ldru(arg_z,-node_size(imm1)))
2576        __(vpush(arg_z))
25779:
2578        __(bne cr3,8b)
2579        __(ldr(arg_x,-node_size*1(imm1)))
2580        __(ldr(arg_y,-node_size*2(imm1)))
2581        __(ldr(arg_z,-node_size*3(imm1)))
2582        __(blr)
2583
2584        /* lexpr count is two: set arg_y, arg_z from the */
2585        /* lexpr, maybe vpop arg_x */
25862:     
2587        __(ldr(arg_y,-node_size*1(imm1)))
2588        __(ldr(arg_z,-node_size*2(imm1)))
2589        __(beqlr cr2)           /* return if (new) nargs = 2 */
2590        __(vpop(arg_x))
2591        __(blr)
2592
2593        /* lexpr count is one: set arg_z from the lexpr, */
2594        /* maybe vpop arg_y, arg_x */
25951:     
2596        __(ldr(arg_z,-node_size(imm1)))
2597        __(bltlr cr2)           /* return if (new) nargs < 2 */
2598        __(vpop(arg_y))
2599        __(beqlr cr2)           /* return if (new) nargs = 2 */
2600        __(vpop(arg_x))
2601        __(blr)
2602       
2603/* Set the special variable in arg_y to the value in arg_z.
2604   Error if arg_y is a constant.
2605   arg_y is a known, non-nil symbol. */
2606_spentry(setqsym)
2607               
2608_spentry(reset)
2609        .globl _SPthrow
2610        __(nop)
2611        __(ref_nrs_value(temp0,toplcatch))
2612        __(li temp1,XSTKOVER)
2613        __(vpush(temp0))
2614        __(vpush(temp1))
2615        __(set_nargs(1))
2616        __(b _SPthrow)
2617
2618       
2619/* "slide" nargs worth of values up the vstack.  IMM0 contains */
2620/* the difference between the current VSP and the target. */
2621_spentry(mvslide)
2622        __(cmpri(cr0,nargs,0))
2623        __(mr imm3,nargs)
2624        __(add imm2,vsp,nargs)
2625        __(add imm2,imm2,imm0)
2626        __(add imm0,vsp,nargs)
2627        __(beq 2f)
26281:
2629        __(cmpri(cr0,imm3,1<<fixnumshift))
2630        __(subi imm3,imm3,1<<fixnumshift)
2631        __(ldru(temp0,-node_size(imm0)))
2632        __(stru(temp0,-node_size(imm2)))
2633        __(bne cr0,1b)
26342:
2635        __(mr vsp,imm2)
2636        __(blr)
2637
2638/* Build a new TSP area to hold nargs worth of multiple-values. */
2639/* Pop the multiple values off of the vstack. */
2640/* The new TSP frame will look like this: */
2641/*
2642+--------+-------+-------+---------+--------+--------+--------+======+----------+
2643| ptr to | zero  | nargs | ptr to  | valn-1 | valn-2 | val-0  | ???? | prev TSP |
2644|  prev  |       |       |  prev   |        |        |        | fill |          |
2645| TSP    |       |       | segment |        |        |        |      |          |
2646+--------+-------+-------+---------+--------+--------+--------+------+----------+
2647 */
2648/* e.g., the first multiple value goes in the last cell in the frame, the */
2649/* count of values goes in the first word, and the word after the value count */
2650/* is 0 if the number of values is even (for alignment). */
2651/* Subsequent calls to .SPadd_values preserve this alignment. */
2652/* .SPrecover_values is therefore pretty simple. */
2653
2654_spentry(save_values)
2655        __(mr imm1,tsp)
2656
2657/* common exit: nargs = values in this set, imm1 = ptr to tsp before call to save_values */
2658local_label(save_values_to_tsp):
2659        __(mr imm2,tsp)
2660        __(dnode_align(imm0,nargs,tsp_frame.fixed_overhead+8)) /* count, link */
2661        __(TSP_Alloc_Var_Boxed_nz(imm0,imm3))
2662        __(str(imm1,tsp_frame.backlink(tsp))) /* keep one tsp "frame" as far as rest of lisp is concerned */
2663        __(str(nargs,tsp_frame.data_offset(tsp)))
2664        __(str(imm2,tsp_frame.data_offset+node_size(tsp))) /* previous tsp */
2665        __(la imm3,tsp_frame.data_offset+node_size*2(tsp))
2666        __(add imm3,imm3,nargs)
2667        __(add imm0,vsp,nargs)
2668        __(cmpr(cr0,imm0,vsp))
2669        __(b 2f)
26701:
2671        __(ldru(arg_z,-node_size(imm0)))
2672        __(cmpr(cr0,imm0,vsp))
2673        __(stru(arg_z,-node_size(imm3)))
26742:
2675        __(bne cr0,1b)
2676        __(add vsp,vsp,nargs) /*  discard values */
2677        __(blr)
2678       
2679
2680/* Add the multiple values that are on top of the vstack to the set */
2681/* saved in the top tsp frame, popping them off of the vstack in the */
2682/* process.  It is an error (a bad one) if the TSP contains something */
2683/* other than a previously saved set of multiple-values. */
2684/* Since adding to the TSP may cause a new TSP segment to be allocated, */
2685/* each add_values call adds another linked element to the list of */
2686/* values. This makes recover_values harder. */
2687
2688_spentry(add_values)
2689        __(cmpri(cr0,nargs,0))
2690        __(ldr(imm1,0(tsp)))
2691        __(bne cr0,local_label(save_values_to_tsp))
2692        __(blr)
2693       
2694/* On entry, R11->callback-index */
2695/* Restore lisp context, then funcall #'%pascal-functions% with */
2696/* two args: callback-index, args-ptr (a macptr pointing to the args on the stack) */
2697_spentry(callback)
2698        /* Save C argument registers */
2699        __(str(r3,c_frame.param0(sp)))
2700        __(str(r4,c_frame.param1(sp)))
2701        __(str(r5,c_frame.param2(sp)))
2702        __(str(r6,c_frame.param3(sp)))
2703        __(str(r7,c_frame.param4(sp)))
2704        __(str(r8,c_frame.param5(sp)))
2705        __(str(r9,c_frame.param6(sp)))
2706        __(str(r10,c_frame.param7(sp)))
2707        __(mflr imm3)
2708        __(str(imm3,c_frame.savelr(sp)))
2709        __(mfcr imm0)
2710        __(str(imm0,c_frame.crsave(sp)))
2711
2712        /* Save the non-volatile registers on the sp stack */
2713        /* This is a non-standard stack frame, but noone will ever see it, */
2714        /* so it doesn't matter. It will look like more of the stack frame pushed below. */
2715        __(stru(sp,-(stack_align(c_reg_save.size))(sp)))
2716        __(stmw r13,c_reg_save.save_gprs(sp))
2717        __(check_stack_alignment(r0))
2718        __(mffs f0)
2719        __(stfd f0,c_reg_save.save_fp_zero(sp))
2720        __(ldr(r31,c_reg_save.save_fp_zero+4(sp)))      /* recover FPSCR image */
2721        __(str(r31,c_reg_save.save_fpscr(sp)))
2722        __(lwi(r30,0x43300000))
2723        __(lwi(r31,0x80000000))
2724        __(str(r30,c_reg_save.save_fp_zero(sp)))
2725        __(str(r31,c_reg_save.save_fp_zero+4(sp)))
2726        __(stfd fp_s32conv,c_reg_save.save_fps32conv(sp))
2727        __(lfd fp_s32conv,c_reg_save.save_fp_zero(sp))
2728        __(stfd fp_zero,c_reg_save.save_fp_zero(sp))
2729        __(lfs fp_zero,lisp_globals.short_float_zero(0))        /* ensure that fp_zero contains 0.0 */
2730
2731/* Restore rest of Lisp context. */
2732/* Could spread out the memory references here to gain a little speed */
2733
2734        __(li loc_pc,0)
2735        __(li fn,0)                     /* subprim, not a lisp function */
2736        __(li temp4,0)
2737        __(li temp3,0)
2738        __(li temp2,0)
2739        __(li temp1,0)
2740        __(li temp0,0)
2741        __(li arg_x,0)
2742        __(box_fixnum(arg_y,r11))       /* callback-index */
2743        __(la arg_z,stack_align(c_reg_save.size)+c_frame.param0(sp))    /* parameters (tagged as a fixnum) */
2744
2745        /* Recover lisp thread context. Have to call C code to do so. */
2746        __(ref_global(r12,get_tcr))
2747        __(mtctr r12)
2748        __(li r3,1)
2749        __(stru(sp,-(stack_align(c_frame.minsiz))(sp)))
2750        __(bctrl)
2751        __(mr rcontext,r3)
2752        __(la sp,(stack_align(c_frame.minsiz))(sp))
2753
2754        __(ldr(vsp,tcr.save_vsp(rcontext)))
2755        __(ldr(tsp,tcr.save_tsp(rcontext)))             
2756        __(li rzero,0)
2757        __(mtxer rzero) /* lisp wants the overflow bit being clear */
2758        __(li imm0,TCR_STATE_LISP)
2759        __(li save0,0)
2760        __(li save1,0)
2761        __(li save2,0)
2762        __(li save3,0)
2763        __(li save4,0)
2764        __(li save5,0)
2765        __(li save6,0)
2766        __(li save7,0)
2767        __(lfd f0,tcr.lisp_fpscr(rcontext))
2768        __(mtfsf 0xff,f0)
2769        __(li allocbase,0)
2770        __(li allocptr,0)       
2771        __(str(imm0,tcr.valence(rcontext)))
2772        __(ldr(allocptr,tcr.save_allocptr(rcontext)))
2773        __(ldr(allocbase,tcr.save_allocbase(rcontext)))
2774
2775        /* load nargs and callback to the lisp */
2776        __(set_nargs(2))
2777        __(ldr(imm2,tcr.cs_area(rcontext)))
2778        __(ldr(imm4,area.active(imm2)))
2779        __(stru(imm4,-lisp_frame.size(sp)))
2780        __(str(imm3,lisp_frame.savelr(sp)))
2781        __(str(vsp,lisp_frame.savevsp(sp)))     /* for stack overflow code */
2782        __(li fname,nrs.callbacks)      /* %pascal-functions% */
2783        __(call_fname)
2784        __(ldr(imm2,lisp_frame.backlink(sp)))
2785        __(ldr(imm3,tcr.cs_area(rcontext)))
2786        __(str(imm2,area.active(imm3)))
2787        __(discard_lisp_frame())
2788        /* save_vsp will be restored from ff_call's stack frame, but */
2789        /* I included it here for consistency. */
2790        /* save_tsp is set below after we exit Lisp context. */
2791        __(str(allocptr,tcr.save_allocptr(rcontext)))
2792        __(str(allocbase,tcr.save_allocbase(rcontext)))
2793        __(str(vsp,tcr.save_vsp(rcontext)))
2794        __(str(tsp,tcr.save_tsp(rcontext)))
2795        /* Exit lisp context */
2796        __(li imm1,TCR_STATE_FOREIGN)
2797        __(str(imm1,tcr.valence(rcontext)))
2798        /* Restore the non-volatile registers & fpscr */
2799        __(lfd fp_zero,c_reg_save.save_fp_zero(sp))
2800        __(ldr(r31,c_reg_save.save_fpscr(sp)))
2801        __(str(r31,c_reg_save.save_fp_zero+4(sp)))
2802        __(lfd f0,c_reg_save.save_fp_zero(sp))
2803        __(mtfsf 0xff,f0)
2804        __(lmw r13,c_reg_save.save_gprs(sp))
2805        __(lfd fp_s32conv,c_reg_save.save_fps32conv(sp))
2806        __(ldr(sp,0(sp)))
2807        __(ldr(r3,c_frame.param0(sp)))
2808        __(ldr(r4,c_frame.param0(sp)))
2809        __(ldr(r5,c_frame.savelr(sp)))
2810        __(mtlr r5)
2811        __(ldr(r5,c_frame.crsave(sp)))
2812        __(mtcr r5)
2813        __(blr)
2814       
2815/* Like misc_alloc (a LOT like it, since it does most of the work), but takes */
2816/* an initial-value arg in arg_z, element_count in arg_x, subtag in arg_y. */
2817/* Calls out to %init-misc, which does the rest of the work. */
2818
2819_spentry(misc_alloc_init)
2820        __(mflr loc_pc)
2821        __(build_lisp_frame(fn,loc_pc,vsp))
2822        __(li fn,0)
2823        __(mr temp0,arg_z)              /* initval */
2824        __(mr arg_z,arg_y)              /* subtag */
2825        __(mr arg_y,arg_x)              /* element-count */
2826        __(bl _SPmisc_alloc)
2827        __(ldr(loc_pc,lisp_frame.savelr(sp)))
2828        __(mtlr loc_pc)
2829        __(ldr(fn,lisp_frame.savefn(sp)))
2830        __(ldr(vsp,lisp_frame.savevsp(sp))) /* vsp may have moved to the bottom of a new stack segment */
2831        __(discard_lisp_frame())
2832        __(li fname,nrs.init_misc)
2833        __(set_nargs(2))
2834        __(mr arg_y,temp0)
2835        __(jump_fname())
2836
2837/* As in stack_misc_alloc above, only with a non-default initial-value. */
2838
2839_spentry(stack_misc_alloc_init)
2840        __(mflr loc_pc)
2841        __(build_lisp_frame(fn,loc_pc,vsp))
2842        __(li fn,0)
2843        __(mr temp0,arg_z) /* initval */
2844        __(mr arg_z,arg_y) /* subtag */
2845        __(mr arg_y,arg_x) /* element-count */
2846        __(bl _SPstack_misc_alloc)
2847        __(ldr(loc_pc,lisp_frame.savelr(sp)))
2848        __(mtlr loc_pc)
2849        __(ldr(fn,lisp_frame.savefn(sp)))
2850        __(ldr(vsp,lisp_frame.savevsp(sp))) /* vsp may have changed due to overflowing a stack segment */
2851        __(discard_lisp_frame())
2852        __(li fname,nrs.init_misc)
2853        __(set_nargs(2))
2854        __(mr arg_y,temp0)
2855        __(jump_fname())
2856
2857/* save the values of a list of special variables (arg_y); set them
2858   to the corresponding values in the list in arg_z.
2859   We've checked to make sure that arg_y is a proper list of bindable
2860   symbols, but we're not sure what's in arg_z.
2861   Save the special binding triplets on the tstack.  If there's not
2862   enough room, die.  Prepend the triplets with a boxed triplet
2863   count. */
2864_spentry(progvsave)
2865        /* Error if arg_z isn't a proper list.  That's unlikely,
2866           but it's better to check now than to crash later.
2867        */
2868        __(cmpri(arg_z,nil_value))
2869        __(mr temp0,arg_z)      /* fast */
2870        __(mr temp1,arg_z)      /* slow */
2871        __(beq 9f)              /* Null list is proper */
28720:     
2873        __(trap_unless_list(temp0,imm0))
2874        __(_cdr(temp2,temp0))   /* (null (cdr fast)) ? */
2875        __(cmpri(temp2,nil_value))
2876        __(trap_unless_list(temp2,imm0))
2877        __(_cdr(temp0,temp2))
2878        __(beq 9f)
2879        __(_cdr(temp1,temp1))
2880        __(cmpr(temp0,temp1))
2881        __(bne 0b)
2882        __(lwi(arg_y,XIMPROPERLIST))
2883        __(set_nargs(2))
2884        __(b _SPksignalerr)
28859:      /* Whew */     
2886       
2887        /* Next, determine the length of arg_y.  We */
2888        /* know that it's a proper list. */
2889        __(li imm0,-node_size)
2890        __(mr temp0,arg_y)
28911:
2892        __(cmpri(cr0,temp0,nil_value))
2893        __(la imm0,node_size(imm0))
2894        __(_cdr(temp0,temp0))
2895        __(bne 1b)
2896        /* imm0 is now (boxed) triplet count. */
2897        /* Determine word count, add 1 (to align), and make room. */
2898        /* if count is 0, make an empty tsp frame and exit */
2899        __(cmpri(cr0,imm0,0))
2900        __(add imm1,imm0,imm0)
2901        __(add imm1,imm1,imm0)
2902        __(dnode_align(imm1,imm1,node_size))
2903        __(bne+ cr0,2f)
2904         __(TSP_Alloc_Fixed_Boxed(8))
2905         __(blr)
29062:
2907        __(la imm1,tsp_frame.fixed_overhead(imm1))      /* tsp header */
2908        __(TSP_Alloc_Var_Boxed_nz(imm1,imm2))
2909        __(str(imm0,tsp_frame.data_offset(tsp)))
2910        __(ldr(imm2,tsp_frame.backlink(tsp)))
2911        __(mr temp0,arg_y)
2912        __(ldr(imm1,tcr.db_link(rcontext)))
29133:
2914        __(_car(temp1,temp0))
2915        __(ldr(imm0,symbol.flags(temp1)))
2916        __(ori imm0,imm0,sym_vbit_bound_mask)
2917        __(_cdr(temp0,temp0))
2918        __(_car(temp2,arg_z))
2919        __(_cdr(arg_z,arg_z))
2920        __(cmpri(cr0,temp0,nil_value))
2921        __(push(temp2,imm2))
2922        __(push(temp1,imm2))
2923        __(push(imm1,imm2))
2924        __(mr imm1,imm2)
2925        __(str(imm0,symbol.flags(temp1)))
2926        __(bne cr0,3b)
2927        __(str(imm1,tcr.db_link(rcontext)))
2928        __(blr)
2929       
2930/*
2931   Restore the special bindings from the top of the tstack,
2932   leaving the tstack frame allocated.
2933   Note that there might be 0 saved bindings, in which case
2934   do nothing.
2935   Note also that this is -only- called from an unwind-protect
2936   cleanup form, and that .SPnthrowXXX is keeping one or more
2937   values in a frame on top of the tstack.
2938*/
2939       
2940_spentry(progvrestore)
2941        __(ldr(imm0,tsp_frame.backlink(tsp)))   /* ignore .SPnthrowXXX values frame */
2942        __(ldr(imm0,tsp_frame.data_offset(imm0)))
2943        __(cmpri(cr0,imm0,0))
2944        __(unbox_fixnum(imm0,imm0))
2945        __(bne+ cr0,_SPunbind_n)
2946        __(blr)
2947
2948_spentry(callbuiltin)
2949        __(ref_nrs_value(fname,builtin_functions))
2950        __(la imm0,misc_data_offset(imm0))
2951        __(ldrx(fname,fname,imm0))
2952        __(jump_fname())
2953
2954/* the value of the nilreg-relative symbol %builtin-functions% should be */
2955/* a vector of symbols.  Call the symbol indexed by imm0 (boxed) and */
2956/* return a single value. */
2957
2958_spentry(callbuiltin0)
2959        __(set_nargs(0))
2960        __(ref_nrs_value(fname,builtin_functions))
2961        __(la imm0,misc_data_offset(imm0))
2962        __(ldrx(fname,fname,imm0))
2963        __(jump_fname())
2964
2965_spentry(callbuiltin1)
2966        __(ref_nrs_value(fname,builtin_functions))
2967        __(set_nargs(1))
2968        __(la imm0,misc_data_offset(imm0))
2969        __(ldrx(fname,fname,imm0))
2970        __(jump_fname())
2971
2972_spentry(callbuiltin2)
2973        __(set_nargs(2))
2974        __(ref_nrs_value(fname,builtin_functions))
2975        __(la imm0,misc_data_offset(imm0))
2976        __(ldrx(fname,fname,imm0))
2977        __(jump_fname())
2978
2979
2980_spentry(callbuiltin3)
2981        __(set_nargs(3))
2982        __(ref_nrs_value(fname,builtin_functions))
2983        __(la imm0,misc_data_offset(imm0))
2984        __(ldrx(fname,fname,imm0))
2985        __(jump_fname())
2986       
2987
2988_spentry(popj)
2989        .globl C(popj)
2990C(popj):
2991        __(ldr(loc_pc,lisp_frame.savelr(sp)))
2992        __(ldr(vsp,lisp_frame.savevsp(sp)))
2993        __(mtlr loc_pc)
2994        __(ldr(fn,lisp_frame.savefn(sp)))
2995        __(discard_lisp_frame())
2996        __(blr)
2997
2998_spentry(restorefullcontext)
2999        __(mflr loc_pc)
3000        __(mtctr loc_pc)
3001        __(ldr(loc_pc,lisp_frame.savelr(sp)))
3002        __(mtlr loc_pc)
3003        __(ldr(vsp,lisp_frame.savevsp(sp)))
3004        __(ldr(fn,lisp_frame.savefn(sp)))
3005        __(discard_lisp_frame())
3006        __(bctr)
3007
3008_spentry(savecontextvsp)
3009        __(ldr(imm0,tcr.cs_limit(rcontext)))
3010        __(build_lisp_frame(fn,loc_pc,vsp))
3011        __(mr fn,nfn)
3012        __(trllt(sp,imm0))
3013        __(blr)
3014
3015_spentry(savecontext0)
3016        __(add imm0,vsp,imm0)
3017        __(build_lisp_frame(fn,loc_pc,imm0))
3018        __(ldr(imm0,tcr.cs_limit(rcontext)))
3019        __(mr fn,nfn)
3020        __(trllt(sp,imm0))
3021        __(blr)
3022
3023
3024/* Like .SPrestorefullcontext, only the saved return address */
3025/* winds up in loc-pc instead of getting thrashed around ... */
3026_spentry(restorecontext)
3027        __(ldr(loc_pc,lisp_frame.savelr(sp)))
3028        __(ldr(vsp,lisp_frame.savevsp(sp)))
3029        __(ldr(fn,lisp_frame.savefn(sp)))
3030        __(discard_lisp_frame())
3031        __(blr)
3032
3033       
3034/* Nargs is valid; all arg regs, lexpr-count pushed by caller. */
3035/* imm0 = vsp to restore. */
3036/* Return all values returned by caller to its caller, hiding */
3037/* the variable-length arglist. */
3038/* If we can detect that the caller's caller didn't expect */
3039/* multiple values, then things are even simpler. */
3040_spentry(lexpr_entry)
3041        __(ref_global(imm1,ret1val_addr))
3042        __(cmpr(cr0,imm1,loc_pc))
3043        __(build_lisp_frame(fn,loc_pc,imm0))
3044        __(bne cr0,1f)
3045        __(ref_global(imm0,lexpr_return))
3046        __(build_lisp_frame(rzero,imm0,vsp))
3047        __(mr loc_pc,imm1)
3048        __(ldr(imm0,tcr.cs_limit(rcontext)))
3049        __(trllt(sp,imm0))
3050        __(li fn,0)
3051        __(blr)
3052
3053/* The single-value case just needs to return to something that'll pop */
3054/* the variable-length frame off of the vstack. */
30551:
3056        __(ref_global(loc_pc,lexpr_return1v))
3057        __(ldr(imm0,tcr.cs_limit(rcontext)))
3058        __(trllt(sp,imm0))
3059        __(li fn,0)
3060        __(blr)
3061
3062/*
3063  Do a system call in Darwin.  The stack is set up much as it would be
3064  for a PowerOpen ABI ff-call:  register parameters are in the stack
3065  frame, and there are 4 extra words at the bottom of the frame that
3066  we can carve a lisp frame out of.
3067
3068  System call return conventions are a little funky in Darwin: if "@sc"
3069  is the address of the "sc" instruction, errors return to @sc+4 and
3070  non-error cases return to @sc+8.  Error values are returned as
3071  positive values in r3; this is true even if the system call returns
3072  a doubleword (64-bit) result.  Since r3 would ordinarily contain
3073  the high half of a doubleword result, this has to be special-cased.
3074
3075  The caller should set the c_frame.crsave field of the stack frame
3076  to 0 if the result is to be interpreted as anything but a doubleword
3077  and to non-zero otherwise.  (This only matters on an error return.)
3078*/
3079       
3080_spentry(darwin_syscall)
3081        __(mflr loc_pc)
3082        __(vpush_saveregs())
3083        __(ldr(imm1,0(sp)))
3084        __(la imm2,-lisp_frame.size(imm1))
3085        __(zero_doublewords imm2,0,lisp_frame.size)
3086        __(str(imm1,lisp_frame.backlink(imm2)))
3087        __(str(imm2,c_frame.backlink(sp)))
3088        __(str(fn,lisp_frame.savefn(imm2)))
3089        __(str(loc_pc,lisp_frame.savelr(imm2)))
3090        __(str(vsp,lisp_frame.savevsp(imm2)))
3091        __(ldr(imm3,tcr.cs_area(rcontext)))
3092        __(str(imm2,area.active(imm3)))
3093        __(str(allocptr,tcr.save_allocptr(rcontext)))
3094        __(str(allocbase,tcr.save_allocbase(rcontext)))
3095        __(str(tsp,tcr.save_tsp(rcontext)))
3096        __(str(vsp,tcr.save_vsp(rcontext)))
3097        __(str(rzero,tcr.ffi_exception(rcontext)))
3098        __(mr save0,rcontext)
3099        __(li r3,TCR_STATE_FOREIGN)
3100        __(str(r3,tcr.valence(rcontext)))
3101        __(li rcontext,0)
3102        __(ldr(r3,c_frame.param0(sp)))
3103        __(ldr(r4,c_frame.param1(sp)))
3104        __(ldr(r5,c_frame.param2(sp)))
3105        __(ldr(r6,c_frame.param3(sp)))
3106        __(ldr(r7,c_frame.param4(sp)))
3107        __(ldr(r8,c_frame.param5(sp)))
3108        __(ldr(r9,c_frame.param6(sp)))
3109        __(ldr(r10,c_frame.param7(sp)))
3110        __(unbox_fixnum(r0,arg_z))
3111        __(sc)
3112        __(b 1f)
3113        __(b 9f)
31141:
3115        __(ldr(imm2,c_frame.crsave(sp)))
3116        __(cmpri(cr0,imm2,0))
3117        __(bne cr0,2f)
3118        /* 32-bit result */
3119        __(neg r3,r3)
3120        __(b 9f)
31212:
3122        /* 64-bit result */
3123        __(neg r4,r3)
3124        __(li r3,-1)
3125
31269:
3127        __(mr imm2,save0)       /* recover context */
3128        __(ldr(sp,c_frame.backlink(sp)))
3129        __(li imm4,TCR_STATE_LISP)
3130        __(li rzero,0)
3131        __(li loc_pc,0)
3132        __(li arg_x,nil_value)
3133        __(li arg_y,nil_value)
3134        __(li arg_z,nil_value)
3135        __(li temp0,nil_value)
3136        __(li temp1,nil_value)
3137        __(li temp2,nil_value)
3138        __(li temp3,nil_value)
3139        __(li temp4,nil_value)
3140        __(li fn,nil_value)
3141        __(vpop_saveregs)
3142        __(mr rcontext,imm2)
3143        __(ldr(allocptr,tcr.save_allocptr(rcontext)))
3144        __(ldr(allocbase,tcr.save_allocbase(rcontext)))
3145        __(ldr(tsp,tcr.save_tsp(rcontext)))
3146        __(str(imm4,tcr.valence(rcontext)))
3147        __(ldr(loc_pc,lisp_frame.savelr(sp)))
3148        __(mtlr loc_pc)
3149        __(ldr(fn,lisp_frame.savefn(sp)))
3150        __(discard_lisp_frame)
3151        __(check_pending_interrupt([cr1]))
3152        __(blr)
3153       
3154       
3155_spentry(builtin_plus)
3156        __(extract_lisptag(imm0,arg_y))
3157        __(extract_lisptag(imm1,arg_z))
3158        __(cmpri(cr0,imm0,tag_fixnum))
3159        __(cmpri(cr1,imm1,tag_fixnum))
3160        __(bne- cr0,1f)
3161        __(bne- cr1,1f)
3162        __(addo. arg_z,arg_y,arg_z)
3163        __(bnslr+)
3164        __(mtxer rzero)
3165        __(unbox_fixnum(imm1,arg_z))
3166        __(xoris imm1,imm1,0xc000)
3167        __(li imm0,one_digit_bignum_header)
3168        __(Misc_Alloc_Fixed(arg_z,imm0,8))
3169        __(str(imm1,misc_data_offset(arg_z)))
3170        __(blr)
31711:
3172        __(jump_builtin(_builtin_plus,2))
3173_spentry(builtin_minus)
3174        __(extract_lisptag(imm0,arg_y))
3175        __(extract_lisptag(imm1,arg_z))
3176        __(cmpri(cr0,imm0,tag_fixnum))
3177        __(cmpri(cr1,imm1,tag_fixnum))
3178        __(bne- cr0,1f)
3179        __(bne- cr1,1f)
3180        __(subo. arg_z,arg_y,arg_z)
3181        __(bnslr+)
3182        __(mtxer rzero)
3183        __(unbox_fixnum(imm1,arg_z))
3184        __(xoris imm1,imm1,0xc000)
3185        __(li imm0,one_digit_bignum_header)
3186        __(Misc_Alloc_Fixed(arg_z,imm0,8))
3187        __(str(imm1,misc_data_offset(arg_z)))
3188        __(blr)
31891:
3190        __(jump_builtin(_builtin_minus,2))
3191_spentry(builtin_times)
3192        __(extract_lisptag(imm0,arg_y))
3193        __(extract_lisptag(imm1,arg_z))
3194        __(cmpri(cr0,imm0,tag_fixnum))
3195        __(cmpri(cr1,imm1,tag_fixnum))
3196        __(unbox_fixnum(imm2,arg_y))
3197        __(bne cr0,1f)
3198        __(bne cr1,1f)
3199        __(mullwo. imm3,arg_z,imm2)
3200        __(bso 2f)              /*  SO set if result would overflow a fixnum */
3201        __(mr arg_z,imm3)
3202        __(blr)
3203        /* Args are fixnums; result can't be */
32042:      __(mtxer rzero)
3205        __(unbox_fixnum(imm3,arg_z))
3206        __(mullw imm1,imm3,imm2) /* imm1 = low  32 bits */
3207        __(mulhw imm0,imm3,imm2) /* imm0 = high 32 bits */
3208        __(b _SPmakes64)
3209
32101:      __(jump_builtin(_builtin_times,2))
3211
3212_spentry(builtin_div)
3213        __(jump_builtin(_builtin_div,2))
3214
3215_spentry(builtin_eq)
3216        __(extract_lisptag(imm0,arg_y))
3217        __(extract_lisptag(imm1,arg_z))
3218        __(cmpri(cr0,imm0,tag_fixnum))
3219        __(cmpri(cr1,imm1,tag_fixnum))
3220        __(cmpr(cr2,arg_y,arg_z))
3221        __(bne- cr0,1f)
3222        __(bne- cr1,1f)
3223        __(li arg_z,nil_value)
3224        __(bnelr cr2)
3225        __(li arg_z,t_value)
3226        __(blr)
32271:
3228        __(jump_builtin(_builtin_eq,2))
3229
3230_spentry(builtin_ne)
3231        __(extract_lisptag(imm0,arg_y))
3232        __(extract_lisptag(imm1,arg_z))
3233        __(cmpri(cr0,imm0,tag_fixnum))
3234        __(cmpri(cr1,imm1,tag_fixnum))
3235        __(cmpr(cr2,arg_y,arg_z))
3236        __(bne- cr0,1f)
3237        __(bne- cr1,1f)
3238        __(li arg_z,nil_value)
3239        __(beqlr cr2)
3240        __(li arg_z,t_value)
3241        __(blr)
32421:
3243        __(jump_builtin(_builtin_ne,2))
3244
3245_spentry(builtin_gt)
3246        __(extract_lisptag(imm0,arg_y))
3247        __(extract_lisptag(imm1,arg_z))
3248        __(cmpri(cr0,imm0,tag_fixnum))
3249        __(cmpri(cr1,imm1,tag_fixnum))
3250        __(cmpr(cr2,arg_y,arg_z))
3251        __(bne- cr0,1f)
3252        __(bne- cr1,1f)
3253        __(li arg_z,nil_value)
3254        __(bnglr cr2)
3255        __(li arg_z,t_value)
3256        __(blr)
32571:
3258        __(jump_builtin(_builtin_gt,2))
3259
3260_spentry(builtin_ge)
3261        __(extract_lisptag(imm0,arg_y))
3262        __(extract_lisptag(imm1,arg_z))
3263        __(cmpri(cr0,imm0,tag_fixnum))
3264        __(cmpri(cr1,imm1,tag_fixnum))
3265        __(cmpr(cr2,arg_y,arg_z))
3266        __(bne- cr0,1f)
3267        __(bne- cr1,1f)
3268        __(li arg_z,nil_value)
3269        __(bltlr cr2)
3270        __(li arg_z,t_value)
3271        __(blr)
32721:
3273        __(jump_builtin(_builtin_ge,2))
3274
3275_spentry(builtin_lt)
3276        __(extract_lisptag(imm0,arg_y))
3277        __(extract_lisptag(imm1,arg_z))
3278        __(cmpri(cr0,imm0,tag_fixnum))
3279        __(cmpri(cr1,imm1,tag_fixnum))
3280        __(cmpr(cr2,arg_y,arg_z))
3281        __(bne- cr0,1f)
3282        __(bne- cr1,1f)
3283        __(li arg_z,nil_value)
3284        __(bnllr cr2)
3285        __(li arg_z,t_value)
3286        __(blr)
32871:
3288        __(jump_builtin(_builtin_lt,2))
3289
3290_spentry(builtin_le)
3291        __(extract_lisptag(imm0,arg_y))
3292        __(extract_lisptag(imm1,arg_z))
3293        __(cmpri(cr0,imm0,tag_fixnum))
3294        __(cmpri(cr1,imm1,tag_fixnum))
3295        __(cmpr(cr2,arg_y,arg_z))
3296        __(bne- cr0,1f)
3297        __(bne- cr1,1f)
3298        __(li arg_z,nil_value)
3299        __(bgtlr cr2)
3300        __(li arg_z,t_value)
3301        __(blr)
33021:
3303        __(jump_builtin(_builtin_le,2))
3304
3305
3306_spentry(builtin_eql)
3307ifdef([PPC64],[
3308        ],[       
3309        __(cmpr(cr0,arg_y,arg_z))
3310        __(extract_lisptag(imm0,arg_y))
3311        __(extract_lisptag(imm1,arg_z))
3312        __(cmpr(cr1,imm0,imm1))
3313        __(beq cr0,1f)
3314        __(cmpri(cr0,imm0,tag_misc))
3315        __(bne cr1,2f)
3316        __(bne cr0,2f)
3317        __(jump_builtin(_builtin_eql,2))
33181:      __(li arg_z,t_value)
3319        __(blr)
33202:      __(li arg_z,nil_value)
3321        __(blr)
3322])       
3323       
3324_spentry(builtin_length)
3325ifdef([PPC64],[
3326        ],[   
3327        __(extract_typecode(imm0,arg_z))
3328        __(cmpri(cr0,imm0,min_vector_subtag))
3329        __(cmpri(cr2,imm0,tag_list))
3330        __(beq- cr0,2f)
3331        __(blt- cr0,3f)
3332        /* (simple-array * (*)) */
3333        __(vector_length(arg_z,arg_z,imm0))
3334        __(blr)
33352:
3336        __(ldr(arg_z,vectorH.logsize(arg_z)))
3337        __(blr)
33383:      __(bne cr2,8f)
3339        __(li temp2,-1<<fixnum_shift)
3340        __(mr temp0,arg_z)      /* fast pointer */
3341        __(mr temp1,arg_z)      /* slow pointer */
33424:      __(extract_lisptag(imm0,temp0))
3343        __(cmpri(cr7,temp0,nil_value))
3344        __(cmpri(cr1,imm0,tag_list))
3345        __(addi temp2,temp2,fixnum_one)
3346        __(beq cr7,9f)
3347        __(andi. imm0,temp2,1<<fixnum_shift)
3348        __(bne cr1,8f)
3349        __(extract_lisptag(imm1,temp1))
3350        __(_cdr(temp0,temp0))
3351        __(cmpri(cr1,imm1,tag_list))
3352        __(beq cr0,4b)
3353        __(bne cr1,8f)
3354        __(_cdr(temp1,temp1))
3355        __(cmpr(cr0,temp0,temp1))
3356        __(bne cr0,4b)
33578:     
3358        __(jump_builtin(_builtin_length,1))
33599:     
3360        __(mr arg_z,temp2)
3361        __(blr)
3362])       
3363
3364_spentry(builtin_seqtype)
3365ifdef([PPC64],[
3366],[               
3367        __(extract_typecode(imm0,arg_z))
3368        __(cmpri(cr0,imm0,tag_list))
3369        __(cmpri(cr1,imm1,min_vector_subtag))
3370        __(beq cr0,1f)
3371        __(blt- cr1,2f)
3372        __(li arg_z,nil_value)
3373        __(blr)
33741:      __(li arg_z,t_value)
3375        __(blr)
33762:
3377        __(jump_builtin(_builtin_seqtype,1))
3378])       
3379       
3380_spentry(builtin_assq)
3381        __(cmpri(arg_z,nil_value))
3382        __(beqlr)
33831:      __(trap_unless_list(arg_z,imm0))
3384        __(_car(arg_x,arg_z))
3385        __(_cdr(arg_z,arg_z))
3386        __(cmpri(cr2,arg_x,nil_value))
3387        __(cmpri(cr1,arg_z,nil_value))
3388        __(beq cr2,2f)
3389        __(trap_unless_list(arg_x,imm0))
3390        __(_car(temp0,arg_x))
3391        __(cmpr(temp0,arg_y))
3392        __(bne cr0,2f)
3393        __(mr arg_z,arg_x)
3394        __(blr)
33952:      __(bne cr1,1b)
3396        __(blr)
3397
3398
3399
3400_spentry(builtin_memq)
3401        __(cmpri(cr1,arg_z,nil_value))
3402        __(b 2f)
34031:      __(trap_unless_list(arg_z,imm0))
3404        __(_car(arg_x,arg_z))
3405        __(_cdr(temp0,arg_z))
3406        __(cmpr(arg_x,arg_y))
3407        __(cmpri(cr1,temp0,nil_value))
3408        __(beqlr)
3409        __(mr arg_z,temp0)
34102:      __(bne cr1,1b)
3411        __(blr)
3412
3413
3414_spentry(builtin_logbitp)
3415        /* Call out unless both fixnums,0 <=  arg_y < 30 */
3416        __(cmplri(cr2,arg_y,30<<fixnum_shift))
3417        __(extract_lisptag(imm0,arg_y))
3418        __(extract_lisptag(imm1,arg_z))
3419        __(cmpri(cr0,imm0,tag_fixnum))
3420        __(cmpri(cr1,imm1,tag_fixnum))
3421        __(unbox_fixnum(imm0,arg_y))
3422        __(subfic imm0,imm0,30)
3423        __(rlwnm imm0,arg_z,imm0,31,31)
3424        __(rlwimi imm0,imm0,4,27,27)
3425        __(bnl cr2,1f)
3426        __(bne cr0,1f)
3427        __(bne cr1,1f)
3428        __(addi arg_z,imm0,nil_value)
3429        __(blr)
34301:
3431        __(jump_builtin(_builtin_logbitp,2))
3432
3433_spentry(builtin_logior)
3434        __(extract_lisptag(imm0,arg_y))
3435        __(extract_lisptag(imm1,arg_z))
3436        __(cmpri(cr0,imm0,tag_fixnum))
3437        __(cmpri(cr1,imm1,tag_fixnum))
3438        __(bne- cr0,1f)
3439        __(bne- cr1,1f)
3440        __(or arg_z,arg_y,arg_z)
3441        __(blr)
34421:
3443        __(jump_builtin(_builtin_logior,2))
3444
3445_spentry(builtin_logand)
3446        __(extract_lisptag(imm0,arg_y))
3447        __(extract_lisptag(imm1,arg_z))
3448        __(cmpri(cr0,imm0,tag_fixnum))
3449        __(cmpri(cr1,imm1,tag_fixnum))
3450        __(bne- cr0,1f)
3451        __(bne- cr1,1f)
3452        __(and arg_z,arg_y,arg_z)
3453        __(blr)
34541:
3455        __(jump_builtin(_builtin_logand,2))
3456       
3457_spentry(builtin_ash)
3458        __(cmpri(cr1,arg_z,0))
3459        __(extract_lisptag(imm0,arg_y))
3460        __(extract_lisptag(imm1,arg_z))
3461        __(cmpri(cr0,imm0,tag_fixnum))
3462        __(cmpri(cr3,imm1,tag_fixnum))
3463        __(cmpri(cr2,arg_z,-(29<<2)))   /* !! 2 =  fixnumshift */
3464        __(bne- cr0,9f)
3465        __(bne- cr3,9f)
3466        __(bne cr1,0f)
3467        __(mr arg_z,arg_y)      /* (ash n 0) => n */
3468        __(blr)
34690:             
3470        __(unbox_fixnum(imm1,arg_y))
3471        __(unbox_fixnum(imm0,arg_z))
3472        __(bgt cr1,2f)
3473        /* (ash n -count) => fixnum */
3474        __(neg imm2,imm0)
3475        __(bgt cr2,1f)
3476        __(li imm2,31)
34771:     
3478        __(sraw imm0,imm1,imm2)
3479        __(box_fixnum(arg_z,imm0))
3480        __(blr)
3481        /* Integer-length of arg_y/imm1 to imm2 */
34822:             
3483        __(cntlzw. imm2,imm1)
3484        __(bne 3f)              /* cr0[eq] set if negative */
3485        __(not imm2,imm1)
3486        __(cntlzw imm2,imm2)
34873:
3488        __(subfic imm2,imm2,32)
3489        __(add imm2,imm2,imm0)   /* imm2 <- integer-length(imm1) + count */
3490        __(cmpri(cr1,imm2,31-fixnumshift))
3491        __(cmpri(cr2,imm0,32))
3492        __(slw imm2,imm1,imm0)
3493        __(bgt cr1,6f)
3494        __(box_fixnum(arg_z,imm2))
3495        __(blr)
34966:
3497        __(bgt cr2,9f)
3498        __(bne cr2,7f)
3499        /* Shift left by 32 bits exactly */
3500        __(mr imm0,imm1)
3501        __(li imm1,0)
3502        __(beq _SPmakes64)
3503        __(b _SPmakeu64)
35047:
3505        /* Shift left by fewer than 32 bits, result not a fixnum */
3506        __(subfic imm0,imm0,32)
3507        __(beq 8f)
3508        __(srw imm0,imm1,imm0)
3509        __(mr imm1,imm2)
3510        __(b _SPmakeu64)
35118:     
3512        __(sraw imm0,imm1,imm0)
3513        __(mr imm1,imm2)
3514        __(b _SPmakes64)       
35159:             
3516        __(jump_builtin(_builtin_ash,2))
3517
3518_spentry(builtin_negate)
3519        __(extract_lisptag_(imm0,arg_z))
3520        __(bne- cr0,1f)
3521        __(nego. arg_z,arg_z)
3522        __(bnslr+)
3523        __(mtxer rzero)
3524        __(unbox_fixnum(imm1,arg_z))
3525        __(xoris imm1,imm1,0xc000)
3526        __(li imm0,one_digit_bignum_header)
3527        __(Misc_Alloc_Fixed(arg_z,imm0,8))
3528        __(str(imm1,misc_data_offset(arg_z)))
3529        __(blr)
35301:
3531        __(jump_builtin(_builtin_negate,1))
3532
3533_spentry(builtin_logxor)
3534        __(extract_lisptag(imm0,arg_y))
3535        __(extract_lisptag(imm1,arg_z))
3536        __(cmpri(cr0,imm0,tag_fixnum))
3537        __(cmpri(cr1,imm1,tag_fixnum))
3538        __(bne- cr0,1f)
3539        __(bne- cr1,1f)
3540        __(xor arg_z,arg_y,arg_z)
3541        __(blr)
35421:
3543        __(jump_builtin(_builtin_logxor,2))
3544
3545
3546_spentry(builtin_aref1)
3547        .globl _SPsubtag_misc_ref
3548        __(extract_typecode(imm0,arg_y))
3549        __(cmpri(cr0,imm0,min_vector_subtag))
3550        __(box_fixnum(arg_x,imm0))
3551        __(bgt cr0,1f)
3552        __(jump_builtin(_builtin_aref1,2))
35531:
3554        __(b _SPsubtag_misc_ref)
3555
3556_spentry(builtin_aset1)
3557        __(extract_typecode(imm0,arg_x))
3558        __(cmpri(cr0,imm0,min_vector_subtag))
3559        __(box_fixnum(temp0,imm0))
3560        __(bgt cr0,1f)
3561        __(jump_builtin(_builtin_aset1,3))
35621:
3563        __(b _SPsubtag_misc_set)
3564
3565/* Enter the debugger */
3566_spentry(breakpoint)
3567        __(li r3,0)
3568        __(tw 28,sp,sp) /* 28 = lt|gt|eq (assembler bug for the latter) */
3569        __(blr)         /* if handler didn't */
3570
3571/*
3572        We're entered with an eabi_c_frame on the C stack.  There's a
3573        lisp_frame reserved underneath it; we'll link it in in a minute.
3574        Load the outgoing GPR arguments from eabi_c_frame.param[0-7],
3575        then shrink the eabi_c_frame.
3576*/
3577       
3578_spentry(eabi_ff_call)
3579        __(mflr loc_pc)
3580        __(str(sp,eabi_c_frame.savelr(sp)))
3581        __(vpush_saveregs())            /* Now we can use save0-save7 to point to stacks */
3582        __(mr save0,rcontext)   /* or address globals. */
3583        __(extract_typecode(imm0,arg_z))
3584        __(cmpri(imm0,subtag_macptr))
3585        __(ldr(save1,0(sp)))    /* bottom of reserved lisp frame */
3586        __(la save2,-lisp_frame.size(save1))    /* top of lisp frame*/
3587        __(zero_doublewords save2,0,lisp_frame.size)
3588        __(str(save1,lisp_frame.backlink(save2)))
3589        __(str(save2,c_frame.backlink(sp)))
3590        __(str(fn,lisp_frame.savefn(save2)))
3591        __(str(loc_pc,lisp_frame.savelr(save2)))
3592        __(str(vsp,lisp_frame.savevsp(save2)))
3593        __(bne 1f)
3594        __(ldr(arg_z,macptr.address(arg_z)))
35951:
3596        __(ldr(save3,tcr.cs_area(rcontext)))
3597        __(str(save2,area.active(save3)))
3598        __(str(allocptr,tcr.save_allocptr(rcontext)))
3599        __(str(allocbase,tcr.save_allocbase(rcontext)))
3600        __(str(tsp,tcr.save_tsp(rcontext)))
3601        __(str(vsp,tcr.save_vsp(rcontext)))
3602        __(mtctr arg_z)
3603        __(str(rzero,tcr.ffi_exception(rcontext)))
3604        __(mffs f0)
3605        __(stfd f0,tcr.lisp_fpscr(rcontext))    /* remember lisp's fpscr */
3606        __(mtfsf 0xff,fp_zero)  /* zero foreign fpscr */
3607        __(li imm1,TCR_STATE_FOREIGN)
3608        __(str(imm1,tcr.valence(rcontext)))
3609        __(ldr(r2,tcr.native_thread_info(rcontext)))
3610        __(ldr(r13,lisp_globals.saveR13(0)))
3611        __(ldr(r3,eabi_c_frame.param0(sp)))
3612        __(ldr(r4,eabi_c_frame.param1(sp)))
3613        __(ldr(r5,eabi_c_frame.param2(sp)))
3614        __(ldr(r6,eabi_c_frame.param3(sp)))
3615        __(ldr(r7,eabi_c_frame.param4(sp)))
3616        __(ldr(r8,eabi_c_frame.param5(sp)))
3617        __(ldr(r9,eabi_c_frame.param6(sp)))
3618        __(ldr(r10,eabi_c_frame.param7(sp)))
3619        __(la save1,eabi_c_frame.minsiz-eabi_c_frame.param0(sp))
3620        __(str(rzero,eabi_c_frame.savelr(save1)))
3621        __(str(save2,eabi_c_frame.backlink(save1)))
3622        __(mr sp,save1)
3623        /* If we're calling a varargs C function, it'll want to
3624        know whether or not we've passed any args in FP regs.
3625        Better to say that we did (and force callee to save FP
3626        arg regs on entry) than to say that we didn't and get
3627        garbage results */
3628        __(crset 6)
3629        __(bctrl)
3630_local_label(FF_call_return_common):
3631        /* C should have preserved save0 (= rcontext) for us. */
3632        __(ldr(sp,0(sp)))
3633        __(mr imm2,save0)
3634        __(ldr(vsp,lisp_frame.savevsp(sp)))
3635        __(vpop_saveregs())
3636        __(li rzero,0)
3637        __(mr loc_pc,rzero)
3638        __(li arg_x,nil_value)
3639        __(li arg_y,nil_value)
3640        __(li arg_z,nil_value)
3641        __(li temp0,nil_value)
3642        __(li temp1,nil_value)
3643        __(li temp2,nil_value)
3644        __(li temp3,nil_value)
3645        __(li temp4,nil_value)
3646        __(li fn,nil_value)
3647        __(mr rcontext,imm2)
3648        __(li imm2,TCR_STATE_LISP)
3649        __(str(imm2,tcr.valence(rcontext)))     
3650        __(ldr(allocptr,tcr.save_allocptr(rcontext)))
3651        __(ldr(allocbase,tcr.save_allocbase(rcontext)))
3652        __(ldr(tsp,tcr.save_tsp(rcontext)))
3653        __(ldr(loc_pc,lisp_frame.savelr(sp)))
3654        __(mtlr loc_pc)
3655        __(ldr(fn,lisp_frame.savefn(sp)))
3656        __(mffs f0)
3657        __(stfd f0,8(sp))
3658        __(lwz imm3,12(sp))     /* imm3 = FPSCR after call */
3659        __(clrrwi imm2,imm3,8)
3660        __(discard_lisp_frame())
3661        __(str(imm2,tcr.ffi_exception(rcontext)))
3662        __(lfd f0,tcr.lisp_fpscr(rcontext))
3663        __(mtfsf 0xff,f0)
3664        __(check_pending_interrupt([cr1]))
3665        __(blr)
3666       
3667/*
3668        This gets called with R11 holding the unboxed callback index.
3669*/
3670_spentry(eabi_callback)
3671        /* First, we extend the C frame so that it has room for
3672        incoming arg regs. */
3673        __(ldr(r0,eabi_c_frame.backlink(sp)))
3674        __(stru(r0,eabi_c_frame.param0-varargs_eabi_c_frame.incoming_stack_args(sp)))
3675        __(mflr r0)
3676        __(str(r0,varargs_eabi_c_frame.savelr(sp)))
3677        __(str(r3,varargs_eabi_c_frame.gp_save+(0*4)(sp)))
3678        __(str(r4,varargs_eabi_c_frame.gp_save+(1*4)(sp)))
3679        __(str(r5,varargs_eabi_c_frame.gp_save+(2*4)(sp)))
3680        __(str(r6,varargs_eabi_c_frame.gp_save+(3*4)(sp)))
3681        __(str(r7,varargs_eabi_c_frame.gp_save+(4*4)(sp)))
3682        __(str(r8,varargs_eabi_c_frame.gp_save+(5*4)(sp)))
3683        __(str(r9,varargs_eabi_c_frame.gp_save+(6*4)(sp)))
3684        __(str(r10,varargs_eabi_c_frame.gp_save+(7*4)(sp)))
3685        /* Could check the appropriate CR bit and skip saving FP regs here */
3686        __(stfd f1,varargs_eabi_c_frame.fp_save+(0*8)(sp))
3687        __(stfd f2,varargs_eabi_c_frame.fp_save+(1*8)(sp))
3688        __(stfd f3,varargs_eabi_c_frame.fp_save+(2*8)(sp))
3689        __(stfd f4,varargs_eabi_c_frame.fp_save+(3*8)(sp))
3690        __(stfd f5,varargs_eabi_c_frame.fp_save+(4*8)(sp))
3691        __(stfd f6,varargs_eabi_c_frame.fp_save+(5*8)(sp))
3692        __(stfd f7,varargs_eabi_c_frame.fp_save+(6*8)(sp))
3693        __(stfd f8,varargs_eabi_c_frame.fp_save+(7*8)(sp))
3694        __(la r0,varargs_eabi_c_frame.incoming_stack_args(sp))
3695        __(str(r0,varargs_eabi_c_frame.overflow_arg_area(sp)))
3696        __(la r0,varargs_eabi_c_frame.regsave(sp))
3697        __(str(r0,varargs_eabi_c_frame.reg_save_area(sp)))
3698        __(li r0,0)
3699        __(str(r0,varargs_eabi_c_frame.flags(sp)))
3700
3701        /* Save the non-volatile registers on the sp stack */
3702        /* This is a non-standard stack frame, but noone will ever see it, */
3703        /* so it doesn't matter. It will look like more of the stack frame pushed below. */
3704        __(stru(sp,-(c_reg_save.size)(sp)))
3705        __(stmw r13,c_reg_save.save_gprs(sp))
3706        __(mffs f0)
3707        __(stfd f0,c_reg_save.save_fp_zero(sp))
3708        __(ldr(r31,c_reg_save.save_fp_zero+4(sp)))      /* recover FPSCR image */
3709        __(str(r31,c_reg_save.save_fpscr(sp)))
3710        __(lwi(r30,0x43300000))
3711        __(lwi(r31,0x80000000))
3712        __(str(r30,c_reg_save.save_fp_zero(sp)))
3713        __(str(r31,c_reg_save.save_fp_zero+4(sp)))
3714        __(stfd fp_s32conv,c_reg_save.save_fps32conv(sp))
3715        __(lfd fp_s32conv,c_reg_save.save_fp_zero(sp))
3716        __(stfd fp_zero,c_reg_save.save_fp_zero(sp))
3717        __(lfs fp_zero,lisp_globals.short_float_zero(0))        /* ensure that fp_zero contains 0.0 */
3718
3719       
3720/* Restore rest of Lisp context. */
3721/* Could spread out the memory references here to gain a little speed */
3722        __(li loc_pc,0)
3723        __(li fn,0)                     /* subprim, not a lisp function */
3724        __(li temp4,0)
3725        __(li temp3,0)
3726        __(li temp2,0)
3727        __(li temp1,0)
3728        __(li temp0,0)
3729        __(li arg_x,0)
3730        __(box_fixnum(arg_y,r11))       /* callback-index */
3731        __(la arg_z,c_reg_save.size+varargs_eabi_c_frame.gp_save(sp))   /* parameters (tagged as a fixnum) */
3732
3733        /* Recover lisp thread context. Have to call C code to do so. */
3734        __(ref_global(r12,get_tcr))
3735        __(mtctr r12)
3736        __(li r3,1)
3737        __(stru(sp,-(stack_align(eabi_c_frame.minsiz))(sp)))
3738        __(bctrl)
3739        __(la sp,(stack_align(eabi_c_frame.minsiz))(sp))
3740        __(mr rcontext,r3)
3741        __(li allocptr,0)
3742        __(li allocbase,0)
3743        __(ldr(vsp,tcr.save_vsp(rcontext)))
3744        __(ldr(tsp,tcr.save_tsp(rcontext)))             
3745        __(li rzero,0)
3746        __(mtxer rzero) /* lisp wants the overflow bit clear */
3747        __(li imm0,TCR_STATE_LISP)
3748        __(li save0,0)
3749        __(li save1,0)
3750        __(li save2,0)
3751        __(li save3,0)
3752        __(li save4,0)
3753        __(li save5,0)
3754        __(li save6,0)
3755        __(li save7,0)
3756        __(str(imm0,tcr.valence(rcontext)))
3757        __(ldr(allocptr,tcr.save_allocptr(rcontext)))
3758        __(ldr(allocbase,tcr.save_allocbase(rcontext)))
3759        __(lfd f0,tcr.lisp_fpscr(rcontext))
3760        __(mtfsf 0xff,f0)
3761
3762        /* load nargs and callback to the lisp */
3763        __(set_nargs(2))
3764        __(ldr(imm2,tcr.cs_area(rcontext)))
3765        __(ldr(imm4,area.active(imm2)))
3766        __(stru(imm4,-lisp_frame.size(sp)))
3767        __(str(imm3,lisp_frame.savelr(sp)))
3768        __(str(vsp,lisp_frame.savevsp(sp)))     /* for stack overflow code */
3769        __(li fname,nrs.callbacks)      /* %pascal-functions% */
3770        __(call_fname)
3771        __(ldr(imm2,lisp_frame.backlink(sp)))
3772        __(ldr(imm3,tcr.cs_area(rcontext)))
3773        __(str(imm2,area.active(imm3)))
3774        __(discard_lisp_frame())
3775        /* save_vsp will be restored from ff_call's stack frame, but */
3776        /* I included it here for consistency. */
3777        /* save_tsp is set below after we exit Lisp context. */
3778        __(str(allocptr,tcr.save_allocptr(rcontext)))
3779        __(str(allocbase,tcr.save_allocbase(rcontext)))
3780        __(str(vsp,tcr.save_vsp(rcontext)))
3781        __(str(tsp,tcr.save_tsp(rcontext)))
3782        /* Exit lisp context */
3783        /* This is not necessary yet, but will be once we can be interrupted */
3784        __(li imm1,TCR_STATE_FOREIGN)
3785        __(str(imm1,tcr.valence(rcontext)))
3786        /* Restore the non-volatile registers & fpscr */
3787        __(lfd fp_zero,c_reg_save.save_fp_zero(sp))
3788        __(ldr(r31,c_reg_save.save_fpscr(sp)))
3789        __(str(r31,c_reg_save.save_fp_zero+4(sp)))
3790        __(lfd f0,c_reg_save.save_fp_zero(sp))
3791        __(mtfsf 0xff,f0)
3792        __(lmw r13,c_reg_save.save_gprs(sp))
3793        __(lfd fp_s32conv,c_reg_save.save_fps32conv(sp))
3794        __(ldr(sp,0(sp)))
3795
3796        __(ldr(r3,varargs_eabi_c_frame.gp_save+(0*4)(sp)))
3797        __(ldr(r4,varargs_eabi_c_frame.gp_save+(1*4)(sp)))
3798        __(lfd f1,varargs_eabi_c_frame.fp_save+(8*8)(sp))
3799        __(ldr(r5,varargs_eabi_c_frame.savelr(sp)))
3800        __(str(r5,varargs_eabi_c_frame.old_savelr(sp)))
3801        __(mtlr r5)
3802        __(ldr(r5,varargs_eabi_c_frame.backlink(sp)))
3803        __(str(r5,varargs_eabi_c_frame.old_backlink(sp)))
3804        __(la sp,varargs_eabi_c_frame.old_backlink(sp))
3805        __(ldr(r2,tcr.native_thread_info(rcontext)))
3806        __(blr)
3807       
3808/*
3809        Do a linux system call:  the system call index is (boxed)
3810        in arg_z, and other arguments are in an eabi_c_frame on
3811        the C stack.  As is the case with an eabi_ff_call, there's
3812        a lisp frame reserved underneath the eabi_c_frame.
3813
3814        This is a little simpler than eabi_ff_call, because we
3815        can assume that there are no synchronous callbacks to
3816        lisp (that might cause a GC.)  It's also simpler for the
3817        caller, since we return error status atomically.
3818
3819        A system call can clobber any or all of r9-r12, so we need
3820        to save and restore allocptr, allocbase, and tsp.
3821        */
3822_spentry(syscall)
3823/*
3824        We're entered with an eabi_c_frame on the C stack.  There's a
3825        lisp_frame reserved underneath it; we'll link it in in a minute.
3826        Load the outgoing GPR arguments from eabi_c_frame.param[0-7],
3827        then shrink the eabi_c_frame.
3828*/
3829        __(mflr loc_pc)
3830        __(str(sp,eabi_c_frame.savelr(sp)))
3831        __(li arg_x,nil_value)
3832        __(mr temp0,rcontext)
3833        __(ldr(temp1,c_frame.backlink(sp)))     /* bottom of reserved lisp frame */
3834        __(la temp2,-lisp_frame.size(temp1))    /* top of lisp frame */
3835        __(zero_doublewords temp2,0,lisp_frame.size)
3836        __(str(temp1,lisp_frame.backlink(temp2)))
3837        __(str(temp2,c_frame.backlink(sp)))
3838        __(str(fn,lisp_frame.savefn(temp2)))
3839        __(str(loc_pc,lisp_frame.savelr(temp2)))
3840        __(str(vsp,lisp_frame.savevsp(temp2)))
3841        __(ldr(temp3,tcr.cs_area(rcontext)))
3842        __(str(temp2,area.active(temp3)))
3843        __(str(allocptr,tcr.save_allocptr(rcontext)))
3844        __(str(allocbase,tcr.save_allocbase(rcontext)))
3845        __(str(tsp,tcr.save_tsp(rcontext)))
3846        __(str(vsp,tcr.save_vsp(rcontext)))
3847        __(str(rzero,tcr.ffi_exception(rcontext)))
3848        __(li imm1,TCR_STATE_FOREIGN)
3849        __(str(imm1,tcr.valence(rcontext)))
3850        __(ldr(r13,lisp_globals.saveR13(0)))
3851        __(ldr(r3,eabi_c_frame.param0(sp)))
3852        __(ldr(r4,eabi_c_frame.param1(sp)))
3853        __(ldr(r5,eabi_c_frame.param2(sp)))
3854        __(ldr(r6,eabi_c_frame.param3(sp)))
3855        __(ldr(r7,eabi_c_frame.param4(sp)))
3856        __(ldr(r8,eabi_c_frame.param5(sp)))
3857        __(ldr(r9,eabi_c_frame.param6(sp)))
3858        __(ldr(r10,eabi_c_frame.param7(sp)))
3859        __(la temp1,eabi_c_frame.minsiz-eabi_c_frame.param0(sp))
3860        __(str(rzero,eabi_c_frame.savelr(temp1)))
3861        __(str(temp2,eabi_c_frame.backlink(temp1)))
3862        __(mr sp,temp1)
3863        __(unbox_fixnum(r0,arg_z))
3864        __(sc)
3865        __(nop)
3866        /* C should have preserved temp0 (= rcontext) for us. */
3867        __(ldr(sp,0(sp)))
3868        __(mr imm2,temp0)
3869        __(ldr(vsp,lisp_frame.savevsp(sp)))
3870        __(li rzero,0)
3871        __(mr loc_pc,rzero)
3872        __(mr fn,rzero)
3873        __(li arg_x,nil_value)
3874        __(li arg_y,nil_value)
3875        __(li arg_z,nil_value)
3876        __(li temp0,nil_value)
3877        __(li temp1,nil_value)
3878        __(li temp2,nil_value)
3879        __(li temp3,nil_value)
3880        __(li temp4,nil_value)
3881        __(li fn,nil_value)
3882        __(li imm3,TCR_STATE_LISP)
3883        __(mr rcontext,imm2)
3884        __(stw imm3,tcr.valence(rcontext))
3885        __(ldr(allocptr,tcr.save_allocptr(rcontext)))
3886        __(ldr(allocbase,tcr.save_allocbase(rcontext)))
3887        __(ldr(tsp,tcr.save_tsp(rcontext)))
3888        __(ldr(loc_pc,lisp_frame.savelr(sp)))
3889        __(mtlr loc_pc)
3890        __(ldr(fn,lisp_frame.savefn(sp)))
3891        __(discard_lisp_frame())
3892        __(check_pending_interrupt([cr1]))
3893        __(bnslr)
3894        __(neg r3,r3)
3895        __(mtxer rzero)
3896        __(blr)
3897       
3898/* arg_z should be of type (UNSIGNED-BYTE 64); return high 32 bits
3899        in imm0, low 32 bits in imm1 */
3900
3901_spentry(getu64)
3902        __(extract_typecode(imm0,arg_z))
3903        __(cmpri(cr0,imm0,tag_fixnum))
3904        __(cmpri(cr1,arg_z,0))
3905        __(cmpri(cr2,imm0,subtag_bignum))
3906        __(unbox_fixnum(imm1,arg_z))
3907        __(bne cr0,8f)
3908        __(bgelr cr1)
39099:
3910        __(uuo_interr(error_object_not_u64,arg_z))
39118:
3912        __(bne- cr2,9b)
3913        __(getvheader(imm2,arg_z))
3914        __(cmpri(cr2,imm2,two_digit_bignum_header))
3915        __(vrefr(imm1,arg_z,0))
3916        __(cmpri(cr1,imm1,0))
3917        __(li imm0,0)
3918        __(bge cr2,2f)
3919        __(blt- cr1,9b)
3920        __(blr)
39212:
3922        __(cmpri(cr0,imm2,three_digit_bignum_header))
3923        __(vrefr(imm0,arg_z,1))
3924        __(cmpri(cr1,imm0,0))
3925        __(bne cr2,3f)
3926        __(blt- cr1,9b)
3927        __(blr)
39283:
3929        __(vrefr(imm2,arg_z,2))
3930        __(cmpri(cr1,imm2,0))
3931        __(bne- cr0,9b)
3932        __(bne- cr1,9b)
3933        __(blr)
3934
3935/* arg_z should be of type (SIGNED-BYTE 64); return high 32 bits
3936        in imm0, low 32 bits in imm1 */
3937
3938_spentry(gets64)
3939        __(extract_typecode(imm0,arg_z))
3940        __(cmpri(cr0,imm0,tag_fixnum))
3941        __(cmpri(cr2,imm0,subtag_bignum))
3942        __(unbox_fixnum(imm1,arg_z))
3943        __(srawi imm0,imm1,31)
3944        __(beqlr cr0)
3945        __(bne cr2,9f)
3946        __(getvheader(imm2,arg_z))
3947        __(cmpri(cr2,imm2,two_digit_bignum_header))
3948        __(vrefr(imm1,arg_z,0))
3949        __(srawi imm0,imm1,31)
3950        __(bltlr cr2)
3951        __(vrefr(imm0,arg_z,1))
3952        __(beqlr cr2)
39539:
3954        __(uuo_interr(error_object_not_s64,arg_z))
3955
3956/*
3957  Construct a lisp integer out of the 64-bit unsigned value in
3958  imm0 (high 32 bits) and imm1 (low 32 bits). */
3959_spentry(makeu64)
3960        __(cmpri(cr1,imm0,0))
3961        __(rlwinm. imm2,imm1,0,0,fixnum_shift)
3962        __(li imm2,three_digit_bignum_header)
3963        __(box_fixnum(arg_z,imm1))
3964        __(blt cr1,3f)
3965        __(bne cr1,2f)
3966        __(beqlr cr0) /* A fixnum */
3967        __(blt cr0,2f)
3968        __(li imm2,one_digit_bignum_header)
3969        __(Misc_Alloc_Fixed(arg_z,imm2,8))
3970        __(str(imm1,misc_data_offset(arg_z)))
3971        __(blr)
39722:
3973        __(li imm2,two_digit_bignum_header)
39743:
3975        __(Misc_Alloc_Fixed(arg_z,imm2,16))
3976        __(str(imm1,misc_data_offset(arg_z)))
3977        __(str(imm0,misc_data_offset+4(arg_z)))
3978        __(blr)
3979
3980
3981/*
3982  Construct a lisp integer out of the 64-bit signed value in
3983  imm0 (high 32 bits) and imm1 (low 32 bits). */
3984_spentry(makes64)
3985        __(srawi imm2,imm1,31)
3986        __(cmpr(cr1,imm2,imm0))
3987        __(addo imm2,imm1,imm1)
3988        __(addo. arg_z,imm2,imm2)
3989        __(bne cr1,2f) /* High word is significant */
3990        __(li imm2,one_digit_bignum_header)
3991        __(bnslr cr0) /* No overflow:    fixnum */
3992        __(mtxer rzero)
3993        __(Misc_Alloc_Fixed(arg_z,imm2,8))
3994        __(str(imm1,misc_data_offset(arg_z)))
3995        __(blr)
39962:
3997        __(mtxer rzero)
3998        __(li imm2,two_digit_bignum_header)
3999        __(Misc_Alloc_Fixed(arg_z,imm2,16))
4000        __(str(imm1,misc_data_offset(arg_z)))
4001        __(str(imm0,misc_data_offset+4(arg_z)))
4002        __(blr)
4003
4004_spentry(heap_restv_arg)
4005
4006_spentry(req_heap_restv_arg)
4007
4008_spentry(heap_cons_restv_arg)
4009
4010        /* Restore current thread's interrupt level to arg_z,
4011           noting whether the tcr's interrupt_pending flag was set. */
4012_spentry(restoreintlevel)
4013        __(cmpri(cr1,arg_z,0))
4014        __(ldr(imm0,tcr.interrupt_pending(rcontext)))
4015        __(cmpri(cr0,imm0,0))
4016        __(bne cr1,1f)
4017        __(beq cr0,1f)
4018        __(str(rzero,tcr.interrupt_pending(rcontext)))
4019        __(li nargs,fixnum_one)
4020        __(twgti nargs,0)
4021        __(blr)
40221:     
4023        __(str(arg_z,tcr.interrupt_level(rcontext)))
4024        __(blr)
4025
4026/*
4027  Construct a lisp integer out of the 32-bit signed value in imm0
4028 */
4029_spentry(makes32)
4030        __(addo imm1,imm0,imm0)
4031        __(addo. arg_z,imm1,imm1)
4032        __(bnslr+)
4033        __(mtxer rzero)
4034        __(li imm1,one_digit_bignum_header)
4035        __(Misc_Alloc_Fixed(arg_z,imm1,node_size*2))
4036        __(str(imm0,misc_data_offset(arg_z)))
4037        __(blr)
4038
4039/*
4040  Construct a lisp integer out of the 32-bit unsigned value in imm0
4041 */
4042_spentry(makeu32)
4043        __(clrrwi. imm1,imm0,31-nfixnumtagbits)
4044        __(cmpri(cr1,imm0,0))
4045        __(box_fixnum(arg_z,imm0))
4046        __(beqlr cr0) /* A fixnum */
4047        __(blt cr1,2f)
4048        __(li imm2,one_digit_bignum_header)
4049        __(Misc_Alloc_Fixed(arg_z,imm2,8))
4050        __(str(imm0,misc_data_offset(arg_z)))
4051        __(blr)
40522:
4053        __(li imm2,two_digit_bignum_header)
4054        __(Misc_Alloc_Fixed(arg_z,imm2,16))
4055        __(str(imm0,misc_data_offset(arg_z)))
4056        __(blr)
4057
4058/* 
4059  arg_z should be of type (SIGNED-BYTE 32); return unboxed result in imm0
4060*/
4061_spentry(gets32)
4062        __(extract_typecode(imm1,arg_z))
4063        __(cmpri(cr0,imm1,tag_fixnum))
4064        __(cmpri(cr2,imm1,subtag_bignum))
4065        __(unbox_fixnum(imm0,arg_z))
4066        __(beqlr+ cr0)
4067        __(bne cr2,9f)
4068        __(getvheader(imm1,arg_z))
4069        __(cmpri(cr1,imm1,one_digit_bignum_header))
4070        __(vrefr(imm0,arg_z,0))
4071        __(beqlr+ cr1)
40729:
4073        __(uuo_interr(error_object_not_signed_byte_32,arg_z))
4074
4075/* 
4076  arg_z should be of type (UNSIGNED-BYTE 32); return unboxed result in imm0
4077*/
4078
4079_spentry(getu32)
4080        __(extract_typecode(imm1,arg_z))
4081        __(cmpri(cr0,imm1,tag_fixnum))
4082        __(cmpri(cr1,arg_z,0))
4083        __(cmpri(cr2,imm1,subtag_bignum))
4084        __(unbox_fixnum(imm0,arg_z))
4085        __(bne cr0,8f)
4086        __(bgelr cr1)
40878:
4088        __(bne- cr2,9f)
4089        __(getvheader(imm2,arg_z))
4090        __(cmpri(cr2,imm2,two_digit_bignum_header))
4091        __(vrefr(imm0,arg_z,0))
4092        __(cmpri(cr0,imm0,0))
4093        __(bgt cr2,9f)
4094        __(beq cr2,2f)
4095        __(blt cr0,9f)
4096        __(blr)
40972:
4098        __(vrefr(imm1,arg_z,1))
4099        __(cmpri(cr0,imm1,0))
4100        __(beqlr+ cr0)
4101
41029:
4103        __(uuo_interr(error_object_not_unsigned_byte_32,arg_z))
4104
4105/*
4106  arg_z has overflowed (by one bit) as the result of an addition or subtraction.
4107  Make a bignum out of it.
4108*/
4109_spentry(fix_overflow)
4110        __(mtxer rzero)
4111        __(unbox_fixnum(imm1,arg_z))
4112        __(xoris imm1,imm1,0xc000)
4113        __(li imm0,one_digit_bignum_header)
4114        __(Misc_Alloc_Fixed(arg_z,imm0,8))
4115        __(str(imm1,misc_data_offset(arg_z)))
4116        __(blr)
4117               
4118
4119
4120/*
4121        As per mvpass above, but in this case fname is known to be a
4122        symbol.
4123*/
4124_spentry(mvpasssym)
4125        __(cmpri(cr0,nargs,4*nargregs))
4126        __(mflr loc_pc)
4127        __(mr imm0,vsp)
4128        __(ble+ cr0,1f)
4129         __(subi imm0,imm0,4*nargregs)
4130         __(add imm0,imm0,nargs)
41311:           
4132        __(build_lisp_frame(fn,loc_pc,imm0))
4133        __(ref_global(loc_pc,ret1val_addr))
4134        __(li fn,0)
4135        __(mtlr loc_pc)
4136        __(jump_fname())
4137
4138       
4139/* on entry:  temp0 = svar.  On exit, arg_z = value (possibly unbound_marker),
4140        arg_y = symbol, imm3 = svar.index */
4141_spentry(svar_specref)
4142        __(ldr(imm3,svar.idx(temp0)))
4143        __(ldr(imm0,tcr.tlb_limit(rcontext)))
4144        __(ldr(imm2,tcr.tlb_pointer(rcontext)))
4145        __(ldr(arg_y,svar.symbol(temp0)))
4146        __(cmpr(imm3,imm0))
4147        __(bge 1f)
4148        __(ldrx(arg_z,imm2,imm3))
4149        __(cmpri(arg_z,no_thread_local_binding_marker))
4150        __(bnelr)
41511:      __(ldr(arg_z,symbol.vcell(arg_y)))
4152        __(blr)
4153
4154_spentry(svar_specrefcheck)
4155        __(ldr(imm3,svar.idx(temp0)))
4156        __(ldr(imm0,tcr.tlb_limit(rcontext)))
4157        __(ldr(imm2,tcr.tlb_pointer(rcontext)))
4158        __(ldr(arg_y,svar.symbol(temp0)))
4159        __(cmpr(imm3,imm0))
4160        __(bge 1f)
4161        __(ldrx(arg_z,imm2,imm3))
4162        __(cmpri(arg_z,no_thread_local_binding_marker))
4163        __(bne 2f)
41641:      __(ldr(arg_z,symbol.vcell(arg_y)))
41652:      __(treqi(arg_z,unbound_marker))
4166        __(blr)
4167
4168/* This never affects the symbol's vcell */
4169_spentry(svar_bind)
41700:             
4171        __(ldr(imm3,svar.idx(temp0)))
4172        __(ldr(imm0,tcr.tlb_limit(rcontext)))
4173        __(cmpri(imm3,0))
4174        __(trlle(imm0,imm3))           /* tlb too small */
4175        __(ldr(imm2,tcr.tlb_pointer(rcontext)))
4176        __(ldr(imm1,tcr.db_link(rcontext)))
4177        __(ldrx(temp1,imm2,imm3))
4178        __(beq 9f)
4179        __(vpush(temp1))
4180        __(vpush(imm3))
4181        __(vpush(imm1))
4182        __(strx(arg_z,imm2,imm3))
4183        __(str(vsp,tcr.db_link(rcontext)))
4184        __(blr)
41859:
4186        __(ldr(arg_z,svar.symbol(temp0)))
4187        __(lwi(arg_y,XSYMNOBIND))
4188        __(set_nargs(2))
4189        __(b _SPksignalerr)
4190
4191_spentry(svar_bind_self)
41920:             
4193        __(ldr(imm3,svar.idx(temp0)))
4194        __(ldr(imm0,tcr.tlb_limit(rcontext)))
4195        __(cmpri(imm3,0))
4196        __(trlle(imm0,imm3))           /* tlb too small */
4197        __(ldr(imm2,tcr.tlb_pointer(rcontext)))
4198        __(ldr(imm1,tcr.db_link(rcontext)))
4199        __(ldrx(temp1,imm2,imm3))
4200        __(cmpri(cr1,temp1,no_thread_local_binding_marker))
4201        __(ldr(arg_y,svar.symbol(temp0)))
4202        __(beq 9f)
4203        __(mr arg_z,temp1)
4204        __(bne cr1,1f)
4205        __(ldr(arg_z,symbol.vcell(arg_y)))
42061:             
4207        __(vpush(temp1))
4208        __(vpush(imm3))
4209        __(vpush(imm1))
4210        __(strx(arg_z,imm2,imm3))
4211        __(str(vsp,tcr.db_link(rcontext)))
4212        __(blr)
42139:      __(ldr(arg_z,svar.symbol(temp0)))
4214        __(lwi(arg_y,XSYMNOBIND))
4215        __(set_nargs(2))
4216        __(b _SPksignalerr)
4217
4218_spentry(svar_bind_nil)
42190:             
4220        __(ldr(imm3,svar.idx(temp0)))
4221        __(ldr(imm0,tcr.tlb_limit(rcontext)))
4222        __(cmpri(imm3,0))
4223        __(beq- 9f)
4224        __(trlle(imm0,imm3))           /* tlb too small */
4225        __(ldr(imm2,tcr.tlb_pointer(rcontext)))
4226        __(ldrx(temp1,imm2,imm3))
4227        __(ldr(imm1,tcr.db_link(rcontext)))
4228        __(li imm0,nil_value)
4229        __(vpush(temp1))
4230        __(vpush(imm3))
4231        __(vpush(imm1))
4232        __(strx(imm0,imm2,imm3))
4233        __(str(vsp,tcr.db_link(rcontext)))
4234        __(blr)
42359:      __(ldr(arg_z,svar.symbol(temp0)))
4236        __(lwi(arg_y,XSYMNOBIND))
4237        __(set_nargs(2))
4238        __(b _SPksignalerr)
4239                       
4240_spentry(svar_bind_self_boundp_check)
4241        __(ldr(imm3,svar.idx(temp0)))
4242        __(ldr(imm0,tcr.tlb_limit(rcontext)))
4243        __(cmpri(imm3,0))
4244        __(trlle(imm0,imm3))           /* tlb too small */
4245        __(ldr(imm2,tcr.tlb_pointer(rcontext)))
4246        __(ldrx(temp1,imm2,imm3))
4247        __(ldr(imm1,tcr.db_link(rcontext)))
4248        __(beq 9f)              /* no real tlb index */
4249        __(cmpri(temp1,no_thread_local_binding_marker))
4250        __(mr arg_z,temp1)
4251        __(bne 1f)
4252        __(ldr(arg_y,svar.symbol(temp0)))
4253        __(ldr(arg_z,symbol.vcell(arg_y)))
42541:      __(treqi(arg_z,unbound_marker))       
4255        __(vpush(temp1))
4256        __(vpush(imm3))
4257        __(vpush(imm1))
4258        __(strx(arg_z,imm2,imm3))
4259        __(str(vsp,tcr.db_link(rcontext)))
4260        __(blr)
42619:      __(ldr(arg_z,svar.symbol(temp0)))
4262        __(lwi(arg_y,XSYMNOBIND))
4263        __(set_nargs(2))
4264        __(b _SPksignalerr)
4265
4266_spentry(svar_unbind)
4267        __(ldr(imm1,tcr.db_link(rcontext)))
4268        __(ldr(imm2,tcr.tlb_pointer(rcontext)))   
4269        __(ldr(imm3,binding.sym(imm1)))
4270        __(ldr(temp1,binding.val(imm1)))
4271        __(ldr(imm1,binding.link(imm1)))
4272        __(strx(temp1,imm2,imm3))
4273        __(str(imm1,tcr.db_link(rcontext)))
4274        __(blr)
4275
4276_spentry(svar_unbind_n)
4277        __(ldr(imm1,tcr.db_link(rcontext)))
4278        __(ldr(imm2,tcr.tlb_pointer(rcontext)))   
42791:      __(subi imm0,imm0,1)
4280        __(ldr(imm3,binding.sym(imm1)))
4281        __(ldr(temp1,binding.val(imm1)))
4282        __(cmpri(imm0,0))
4283        __(ldr(imm1,binding.link(imm1)))
4284        __(strx(temp1,imm2,imm3))
4285        __(bne 1b)
4286        __(str(imm1,tcr.db_link(rcontext)))
4287        __(blr)
4288
4289 /*
4290   Clobbers imm1,imm2,imm5,arg_x, arg_y
4291*/
4292_spentry(svar_unbind_to)
4293        __(ldr(imm1,tcr.db_link(rcontext)))
4294        __(ldr(imm2,tcr.tlb_pointer(rcontext)))
42951:      __(ldr(imm5,binding.sym(imm1)))
4296        __(ldr(arg_y,binding.val(imm1)))
4297        __(ldr(imm1,binding.link(imm1)))
4298        __(cmpr(imm0,imm1))
4299        __(strx(arg_y,imm2,imm5))
4300        __(bne 1b)
4301        __(str(imm1,tcr.db_link(rcontext)))
4302        __(blr)
4303       
4304/* temp0 = svar for special symbol, arg_z = new value. */       
4305_spentry(svar_specset)
4306        __(ldr(imm3,svar.idx(temp0)))
4307        __(ldr(imm0,tcr.tlb_limit(rcontext)))
4308        __(ldr(imm2,tcr.tlb_pointer(rcontext)))
4309        __(ldr(arg_y,svar.symbol(temp0)))
4310        __(cmpr(imm3,imm0))
4311        __(bge 1f)
4312        __(ldrx(temp1,imm2,imm3))
4313        __(cmpri(temp1,no_thread_local_binding_marker))
4314        __(beq 1f)
4315        __(strx(arg_z,imm2,imm3))
4316        __(blr)
43171:      __(str(arg_z,symbol.vcell(arg_y)))
4318        __(blr)
4319
4320
4321_spentry(svar_setqsym)
4322        __(ldr(arg_y,svar.symbol(temp0)))
4323        __(ldr(imm0,symbol.flags(arg_y)))
4324        __(andi. imm0,imm0,sym_vbit_const_mask)
4325        __(beq _SPsvar_specset)
4326        __(mr arg_z,arg_y)
4327        __(lwi(arg_y,XCONST))
4328        __(set_nargs(2))
4329        __(b _SPksignalerr)
4330
4331_spentry(svar_progvsave)
4332        /* Error if arg_z isn't a proper list.  That's unlikely,
4333           but it's better to check now than to crash later.
4334        */
4335        __(cmpri(arg_z,nil_value))
4336        __(mr temp4,arg_z)      /* fast */
4337        __(mr temp1,arg_z)      /* slow */
4338        __(beq 9f)              /* Null list is proper */
43390:     
4340        __(trap_unless_list(temp4,imm0))
4341        __(_cdr(temp2,temp4))   /* (null (cdr fast)) ? */
4342        __(cmpri(temp2,nil_value))
4343        __(trap_unless_list(temp2,imm0))
4344        __(_cdr(temp4,temp2))
4345        __(beq 9f)
4346        __(_cdr(temp1,temp1))
4347        __(cmpr(temp4,temp1))
4348        __(bne 0b)
4349        __(lwi(arg_y,XIMPROPERLIST))
4350        __(set_nargs(2))
4351        __(b _SPksignalerr)
43529:      /* Whew */     
4353       
4354        /* Next, determine the length of arg_y.  We */
4355        /* know that it's a proper list. */
4356        __(li imm0,-node_size)
4357        __(mr temp4,arg_y)
43581:
4359        __(cmpri(cr0,temp4,nil_value))
4360        __(la imm0,node_size(imm0))
4361        __(_cdr(temp4,temp4))
4362        __(bne 1b)
4363        /* imm0 is now (boxed) triplet count. */
4364        /* Determine word count, add 1 (to align), and make room. */
4365        /* if count is 0, make an empty tsp frame and exit */
4366        __(cmpri(cr0,imm0,0))
4367        __(add imm1,imm0,imm0)
4368        __(add imm1,imm1,imm0)
4369        __(dnode_align(imm1,imm1,node_size))
4370        __(bne+ cr0,2f)
4371         __(TSP_Alloc_Fixed_Boxed(8))
4372         __(blr)
43732:
4374        __(la imm1,tsp_frame.fixed_overhead(imm1))      /* tsp header */
4375        __(TSP_Alloc_Var_Boxed_nz(imm1,imm2))
4376        __(str(imm0,tsp_frame.data_offset(tsp)))
4377        __(ldr(imm2,tsp_frame.backlink(tsp)))
4378        __(mr temp4,arg_y)
4379        __(ldr(imm1,tcr.db_link(rcontext)))
4380        __(ldr(imm3,tcr.tlb_limit(rcontext)))
43813:
4382        __(cmpri(cr1,arg_z,nil_value))
4383        __(_car(temp0,temp4))
4384        __(ldr(imm0,svar.idx(temp0)))
4385        __(_cdr(temp4,temp4))
4386        __(trlle(imm3,imm0))
4387        __(ldr(imm4,tcr.tlb_pointer(rcontext))) /* Need to reload after trap */
4388        __(ldrx(temp3,imm4,imm0))
4389        __(cmpri(cr0,temp4,nil_value))
4390        __(li temp2,unbound_marker)
4391        __(beq cr1,4f)
4392        __(_car(temp2,arg_z))
4393        __(_cdr(arg_z,arg_z))
43944:      __(push(temp3,imm2))
4395        __(push(imm0,imm2))
4396        __(push(imm1,imm2))
4397        __(strx(temp2,imm4,imm0))
4398        __(mr imm1,imm2)
4399        __(bne cr0,3b)
4400        __(str(imm2,tcr.db_link(rcontext)))
4401        __(blr)
4402               
4403_spentry(svar_progvrestore)
4404        __(ldr(imm0,tsp_frame.backlink(tsp)))   /* ignore .SPnthrowXXX values frame */
4405        __(ldr(imm0,tsp_frame.data_offset(imm0)))
4406        __(cmpri(cr0,imm0,0))
4407        __(unbox_fixnum(imm0,imm0))
4408        __(bne+ cr0,_SPsvar_unbind_n)
4409        __(blr)
4410                       
4411/*  EOF, basically */
4412        .globl _SPsp_end
4413        b _SPsp_end
4414        _endfile
Note: See TracBrowser for help on using the repository browser.