source: branches/arm/lisp-kernel/arm-macros.s @ 13687

Last change on this file since 13687 was 13687, checked in by gb, 11 years ago

More stuff!

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