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

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

Save the (C) non-volatile FPRs (d8-d15, which are aliased to s16-s31)
when creating CATCH/UNWIND-PROTECT frames; restore them appropriately
when throwing/unwinding. (Having lisp treat the C non-volatile FPRs
as non-volatile means that we don't have to do anything special on
callbacks.)

Most of these changes are transparent to compiled code, but try to
account for the presence of an extra stack-allocated object (a
DOUBLE-FLOAT vector) during unwind-protect cleanup. That's all
intended to allow code like:

(tagbody
  (unwind-protect
       (some-protected-form)
    (go OUT))
  OUT
  ...)

to work, but I'm not sure that it ever has on the ARM.

Technically, this is an ABI change but it's obscure enough (and I'm
lazy enough) that I did't change FASL or image version numbers.
If you have code like the above, recompile it (or take it out back
and shoot it, if you prefer.)

Having the values of these FPRs perserved by CATCH and friends is
one prerequisite to using them in compiled lisp code. (There's
a lot more to that, of course.)

File size: 14.1 KB
Line 
1/*   Copyright (C) 2009 Clozure Associates */
2/*   Copyright (C) 1994-2001 Digitool, Inc */
3/*   This file is part of Clozure CL.  */
4
5/*   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public */
6/*   License , known as the LLGPL and distributed with Clozure CL as the */
7/*   file "LICENSE".  The LLGPL consists of a preamble and the LGPL, */
8/*   which is distributed with Clozure CL as the file "LGPL".  Where these */
9/*   conflict, the preamble takes precedence.   */
10
11/*   Clozure CL 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
20/* dnode_align(dest,src,delta) */
21        define(`dnode_align',`
22        __(add $1,$2,#$3+(dnode_size-1))
23        __(bic $1,$1,#((1<<dnode_align_bits)-1))
24')
25
26define(`make_header',`(($1<<num_subtag_bits)|($2&subtag_mask))')
27       
28/* Load a 16-bit constant into $1 */
29define(`movc16',`
30        __ifdef(`DARWIN')
31        __(mov $1,#$2&0xff)
32        __(orr $1,$1,#$2&0xff00)
33        __else
34        __(movw $1,#$2)
35        __endif
36        ')
37       
38define(`test_fixnum',`
39        __(tst $1,#fixnummask)
40        ')
41       
42define(`test_two_fixnums',`
43        __(orr $3,$1,$2)
44        __(test_fixnum($3))
45        ')
46               
47define(`extract_fulltag',`
48        __(and $1,$2,#fulltagmask)
49        ')
50
51define(`extract_lisptag',`
52        __(and $1,$2,#tagmask)
53        ')
54
55define(`extract_lisptag_',`
56        __(ands $1,$1,#tagmask)
57        ')
58
59define(`extract_subtag',`
60        __(ldrb $1,[$2,#misc_subtag_offset])
61        ')
62
63                               
64define(`extract_lowbyte',`
65        __(and $1,$2,#((1<<num_subtag_bits)-1))
66        ')
67
68define(`extract_header',`
69        __(ldr $1,[$2,#misc_header_offset])
70        ')
71
72define(`extract_typecode',`
73        __(extract_lisptag($1,$2))
74        __(cmp $1,#tag_misc)
75        __(ldrbeq $1,[$2,#misc_subtag_offset])
76        ')
77
78define(`box_fixnum',`
79        __(mov $1,$2, lsl #fixnumshift)
80        ')
81
82define(`unbox_fixnum',`
83        __(mov $1,$2, asr #fixnumshift)
84        ')
85
86define(`unbox_character',`
87        __(mov $1,$2, lsr #charcode_shift)
88        ')
89               
90define(`loaddf',`
91        __(lfd $1,dfloat.value($2))')
92       
93define(`storedf',`
94        __(stfd $1,dfloat.value($2))
95        ')
96
97define(`push1',`
98        __(str $1,[$2,#-node_size]!)
99        ')
100       
101        /* Generally not a great idea. */
102define(`pop1',`
103        __(ldr $1,[$2],#node_size)
104        ')
105       
106define(`vpush1',`
107        __(push1($1,vsp))
108        ')
109       
110define(`vpop1',`
111        __(pop1($1,vsp))
112        ')
113       
114               
115define(`unlink',`
116        __(ldr($1,0($1)))
117 ')
118
119       
120define(`set_nargs',`
121        __(mov nargs,#($1)<<fixnumshift)
122        ')
123       
124define(`bitclr',`
125        __(rlwinm $1,$2,0,0x1f&((31-($3))+1),0x1f&((31-($3))-1))
126        ')
127       
128
129define(`vref32',`
130        __(ldr $1,[$2,#misc_data_offset+(($3)<<2)])
131        ')
132       
133define(`vref16',`/* dest,src,n*/
134        __(lhz $1,misc_data_offset+(($3)<<1)($2))
135        ')
136       
137define(`vrefr',`
138        __(vref32($1,$2,$3))
139        ')
140
141
142       
143                       
144define(`getvheader',`
145        __(ldr $1,[$2,#vector.header])
146        ')
147       
148       
149        /* "Length" is fixnum element count */
150define(`header_length',`
151        __(bic $1,$2,#subtag_mask)
152        __(mov $1,$1,lsr #num_subtag_bits-fixnumshift)
153        ')
154
155
156
157define(`vector_length',`
158        __(getvheader($3,$2))
159        __(header_length($1,$3))
160        ')
161
162       
163define(`ref_global',`
164        __(mov ifelse($3,`',$1,$3),#nil_value)
165        __(ldr $1,[ifelse($3,`',$1,$3),#lisp_globals.$2])
166')
167
168
169define(`ref_nrs_value',`
170        __(mov $1,#nil_value)
171        __(ldr $1,[$1,#((nrs.$2)+(symbol.vcell))])
172')
173
174define(`ref_nrs_symbol',`
175        __(movc16($3,nrs.$2))
176        __(add $1,$3,#nil_value)
177        ')
178       
179define(`set_nrs_value',`
180        __(str($1,((nrs.$2)+(symbol.vcell))(0)))
181')
182
183
184        /* vpop argregs - nargs is known to be non-zero */
185define(`vpop_argregs_nz',`
186        __(cmp nargs,#node_size*2)
187        __(vpop1(arg_z))
188        __(ldrhs arg_y,[vsp],#node_size)
189        __(ldrhi arg_x,[vsp],#node_size)
190        ')
191
192               
193        /* vpush argregs */
194define(`vpush_argregs',`
195        new_macro_labels()
196        __(cmp nargs,#0)
197        __(beq macro_label(done))
198        __(cmp nargs,#node_size*2)
199        __(strhi arg_x,[vsp,#-node_size]!)
200        __(strhs arg_y,[vsp,#-node_size]!)
201        __(str arg_z,[vsp,#-node_size]!)
202macro_label(done):
203')
204
205define(`vpush_all_argregs',`
206        __(stmdb vsp!,{arg_z,arg_y,arg_x})
207        ')
208
209define(`vpop_all_argregs',`
210        __(ldmia vsp!,{arg_z,arg_y,arg_x})
211        ')
212                       
213               
214
215/* $1 = arg/temp reg for lisp_frame_marker, $2 = value for lisp_frame.savevsp */               
216define(`build_lisp_frame',`
217        __(mov $1,#lisp_frame_marker)
218        __(stmdb sp!,{$1,ifelse($2,`',vsp,$2),fn,lr})
219')
220
221/* This has the odd side effect of loading lisp_frame_marker into
222   the arg/temp/imm reg $1.  I think that that's probably better
223   than adjusting sp and loading the other regs ; it'd be good
224   to say (at interrupt time) that there's either a lisp frame
225   on the stack or there isn't. */
226define(`restore_lisp_frame',`
227        __(ldm sp!,{$1,vsp,fn,lr})
228        ')
229
230define(`return_lisp_frame',`
231        __(ldm sp!,{$1,vsp,fn,pc})
232        ')
233       
234define(`discard_lisp_frame',`
235        __(add sp,sp,#lisp_frame.size)
236        ')
237       
238       
239define(`_car',`
240        __(ldr $1,[$2,#cons.car])
241')
242       
243define(`_cdr',`
244        __(ldr $1,[$2,#cons.cdr])
245        ')
246       
247define(`_rplaca',`
248        __(str $2,[$1,#cons.car])
249        ')
250       
251define(`_rplacd',`
252        __(str $2,[$1,#cons.cdr])
253        ')
254
255
256define(`trap_unless_lisptag_equal',`
257        new_macro_labels()
258        __(extract_lisptag($3,$1))
259        __(cmp $3,#$2)
260        __(beq macro_label(ok))
261        __(uuo_error_reg_not_lisptag(al,$3,$2))
262macro_label(ok):               
263')
264
265define(`trap_unless_list',`
266        __(trap_unless_lisptag_equal($1,tag_list,$2))
267')
268
269define(`trap_unless_fixnum',`
270        __(new_macro_labels())
271        __(test_fixnum($1))
272        __(beq macro_label(ok))
273        __(uuo_error_reg_not_lisptag(al,$1,tag_fixnum))
274macro_label(ok):       
275        ')
276               
277define(`trap_unless_fulltag_equal',`
278        new_macro_labels()
279        __(extract_fulltag($3,$1))
280        __(cmp $3,#$2)
281        __(beq macro_label(ok))
282        __(uuo_error_reg_not_fulltag(al,$1,$2))
283macro_label(ok):       
284')
285       
286define(`trap_unless_typecode_equal',`
287        new_macro_labels()
288        __(extract_typecode($3,$1))
289        __(cmp $3,#$2)
290        __(beq macro_label(ok))
291        __(uuo_error_reg_not_xtype(al,$2))
292macro_label(ok):               
293')
294       
295/* "jump" to the code-vector of the function in nfn. */
296define(`jump_nfn',`
297        __(ldr pc,[nfn,#_function.entrypoint])
298')
299
300/* "call the code-vector of the function in nfn. */
301define(`call_nfn',`
302        __(ldr lr,[nfn,#_function.entrypoint])
303        __(blx lr)
304')
305       
306
307/* "jump" to the function in fnames function cell. */
308define(`jump_fname',`
309        __(ldr nfn,[fname,#symbol.fcell])
310        __(jump_nfn())
311')
312
313/* call the function in fnames function cell. */
314define(`call_fname',`
315        __(ldr nfn,[fname,#symbol.fcell])
316        __(call_nfn())
317')
318
319define(`funcall_nfn',`
320        __(extract_typecode(imm0,nfn))
321        __(cmp imm0,#subtag_symbol)
322        __(moveq fname,nfn)
323        __(ldreq nfn,[fname,#symbol.fcell])
324        __(cmpne imm0,#subtag_function)
325        __(ldreq pc,[nfn,#_function.entrypoint])
326        __(uuo_error_not_callable(al,nfn))
327
328')
329
330/* Save the non-volatile FPRs (d8-d15) in a stack-allocated vector.
331   Clobber d7,r0,r1.  Note that d7/s14 wind up looking like denormalized
332   floats (we effectively load a vector header into d7.)
333*/       
334   
335define(`push_fprs',`
336        __(movc16(imm0,make_header(8,subtag_double_float_vector)))
337        __(mov imm1,#0)
338        __(fmdrr d7,imm0,imm1)
339        __(fstmfdd sp!,{d7-d15})
340')
341
342/* Pop the non-volatile FPRs (d8-d15) from the stack-consed vector
343   on top of the stack.  This loads the vector header
344   into d7 as a side-effect. */
345define(`pop_fprs',`
346        __(fldmfdd sp!,{d7-d15})
347')
348
349/* Reload the non-volatile FPRs (d8-d15) from the stack-consed vector
350   on top of the stack, leaving the vector in place.  d7 winds up with
351   a denormalized float in it, if anything cares. */
352define(`restore_fprs',`
353        __(fldmfdd $1,{d7-d15})
354')               
355
356/* discard the stack-consed vector which contains a set of 8 non-volatile
357   FPRs. */
358define(`discard_fprs',`
359        __(add sp,sp,#9*8)
360')                       
361       
362define(`mkcatch',`
363        new_macro_labels()
364        __(push_fprs())
365        __(build_lisp_frame(imm0))
366        __(movc16(imm0,make_header(catch_frame.element_count,subtag_catch_frame)))
367        __(movs temp2,fn)
368        __(ldrne temp2,[temp2,_function.codevector])
369        __(ldr temp1,[rcontext,#tcr.last_lisp_frame])
370        __(ldr imm1,[rcontext,#tcr.catch_top])
371        /* imm2 is mvflag */
372        /* arg_z is tag */
373        __(ldr arg_x,[rcontext,#tcr.db_link])
374        __(ldr temp0,[rcontext,#tcr.xframe])
375        __(stmdb sp!,{imm0,imm1,imm2,arg_z,arg_x,temp0,temp1,temp2})
376        __(add imm0,sp,#fulltag_misc)
377        __(str imm0,[rcontext,#tcr.catch_top])
378        __(add lr,lr,#4)
379')     
380
381
382
383
384define(`stack_align',`((($1)+STACK_ALIGN_MASK)&~STACK_ALIGN_MASK)')
385
386define(`clear_alloc_tag',`
387        __(bic allocptr,allocptr,#fulltagmask)
388')
389
390define(`Cons',`
391        new_macro_labels()
392        __(add allocptr,allocptr,#-cons.size+fulltag_cons)
393        __(ldr allocbase,[rcontext,#tcr.save_allocbase])
394        __(cmp allocptr,allocbase)
395        __(bhi macro_label(ok))
396        __(uuo_alloc_trap(al))
397macro_label(ok):               
398        __(str $3,[allocptr,#cons.cdr])
399        __(str $2,[allocptr,#cons.car])
400        __(mov $1,allocptr)
401        __(clear_alloc_tag())
402')
403
404
405/* This is probably only used once or twice in the entire kernel, but */
406/* I wanted a place to describe the constraints on the mechanism. */
407
408/* Those constaints are (not surprisingly) similar to those which apply */
409/* to cons cells, except for the fact that the header (and any length */
410/* field that might describe large arrays) has to have been stored in */
411/* the object if the trap has succeeded on entry to the GC.  It follows */
412/* that storing the register containing the header must immediately */
413/* follow the allocation trap (and an auxiliary length register must */
414/* be stored immediately after the header.)  Successfully falling */
415/* through the trap must emulate any header initialization: it would */
416/* be a bad idea to have allocptr pointing to a zero header ... */
417
418
419
420/* Parameters: */
421
422/* $1 = dest reg */
423/* $2 = header.
424/* $3 = register containing size in bytes.  (We're going to subtract */
425/* fulltag_misc from this; do it in the macro body, rather than force the
426/* (1 ?) caller to do it. */
427
428
429define(`Misc_Alloc',`
430        new_macro_labels()
431        __(sub $3,$3,#fulltag_misc)
432        __(sub allocptr,allocptr,$3)
433        __(ldr allocbase,[rcontext,#tcr.save_allocbase])
434        __(cmp allocptr,allocbase)
435        __(bhi macro_label(ok))
436        __(uuo_alloc_trap(al))
437macro_label(ok):               
438        __(str $2,[allocptr,#misc_header_offset])
439        __(mov $1,allocptr)
440        __(clear_alloc_tag())
441')
442
443/*  Parameters $1, $2 as above; $3 = physical size constant. */
444define(`Misc_Alloc_Fixed',`
445        new_macro_labels()
446        __(add allocptr,allocptr,#(-$3)+fulltag_misc)
447        __(ldr allocbase,[rcontext,#tcr.save_allocbase])
448        __(cmp allocptr,allocbase)
449        __(bhi macro_label(ok))
450        __(uuo_alloc_trap(al))
451macro_label(ok):               
452        __(str $2,[allocptr,#misc_header_offset])
453        __(mov $1,allocptr)
454        __(clear_alloc_tag())
455')
456
457/* Stack-allocate an ivector; $1 = header, $0 = dnode-aligned
458   size in bytes. */
459define(`stack_allocate_ivector',`
460        __(str $1,[sp,-$2]!)
461        ')
462       
463                       
464/* Stack-allocate an ivector and zero its contents; caller may
465   change subtag of header after it's zeroed.
466   $1 = header (tagged as subtag_u32_vector until zeroed), $2 = dnode-
467   aligned size in bytes).  Both $1 and $2 are modified here. */
468define(`stack_allocate_zeroed_ivector',`
469       new_macro_labels()
470        __(str $1,[sp,-$2]!)
471        __(mov $1,#0)
472        __(add $2,sp,$2)
473        __(b macro_label(test))
474macro_label(loop):     
475        __(str $1,[$2])
476macro_label(test):                     
477        __(sub $2,#dnode_size)
478        __(cmp $2,sp)
479        __(str $1,[$2,#node_size])
480        __(bne macro_label(loop))
481        ')
482   
483
484define(`check_enabled_pending_interrupt',`
485        __(ldr $1,[rcontext,#tcr.interrupt_pending])
486        __(cmp $1,0)
487        __(ble $2)
488        __(uuo_interrupt_now(al))
489        ')
490       
491define(`check_pending_interrupt',`
492        new_macro_labels()
493        __(ldr $1,[rcontext,#tcr.tlb_pointer])
494        __(ldr $1,[$1,$INTERRUPT_LEVEL_BINDING_INDEX])
495        __(cmp $1,#0)
496        __(blt macro_label(done))
497        __(check_enabled_pending_interrupt($1,macro_label(done)))
498macro_label(done):
499')
500
501/* $1 = ndigits.  Assumes 4-byte digits */       
502define(`aligned_bignum_size',`((~(dnode_size-1)&(node_size+(dnode_size-1)+(4*$1))))')
503
504define(`suspend_now',`
505        __(uuo_suspend_now(al))
506')
507
508/* $3 points to a uvector header.  Set $1 to the first dnode-aligned address */
509/* beyond the uvector, using imm regs $1 and $2 as temporaries. */
510define(`skip_stack_vector',`
511        new_macro_labels()
512        __(ldr $1,[$3])
513        __(extract_fulltag($2,$1))       
514        __(cmp $2,#fulltag_immheader)
515        __(extract_lowbyte($2,$1))
516        __(mov $1,$1,lsr #num_subtag_bits)
517        __(moveq $1,$1,lsl #2)
518        __(beq macro_label(bytes))
519        __(cmp $2,#max_32_bit_ivector_subtag)
520        __(movle $1,$1,lsl #2)
521        __(ble macro_label(bytes))
522        __(cmp $2,#max_8_bit_ivector_subtag)
523        __(ble macro_label(bytes))
524        __(cmp $2,#max_16_bit_ivector_subtag)
525        __(movle $1,$1,lsl #1)
526        __(ble macro_label(bytes))
527        __(cmp $2,subtag_double_float_vector)
528        __(moveq $1,$1,lsl #3)
529        __(addeq $1,$1,#4)
530        __(beq macro_label(bytes))
531        __(add $1,$1,#7)
532        __(mov $1,$1,lsr #3)
533macro_label(bytes):     
534        __(add $1,$1,#node_size+(dnode_size-1))
535        __(bic $1,$1,#fulltagmask)
536        __(add $1,$1,$3)
537        ')
538
539/* This may need to be inlined.  $1=link, $2=saved sym idx, $3 = tlb, $4 = value */
540define(`do_unbind_to',`
541        __(ldr $1,[rcontext,#tcr.db_link])
542        __(ldr $3,[rcontext,#tcr.tlb_pointer])
5431:      __(ldr $2,[$1,#binding.sym])
544        __(ldr $4,[$1,#binding.val])
545        __(ldr $1,[$1,#binding.link])
546        __(cmp imm0,$1)
547        __(str $4,[$3,$2])
548        __(bne 1b)
549        __(str $1,[rcontext,#tcr.db_link])
550        ')               
551
Note: See TracBrowser for help on using the repository browser.