source: trunk/source/lisp-kernel/arm-macros.s @ 14261

Last change on this file since 14261 was 14169, checked in by gb, 9 years ago

Lots more changes, most of which have to do with Mach exception handling
on ARM.

File size: 12.6 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        __(extract_lisptag($3,$1))
258        __(cmp $3,#$2)
259        __(uuo_error_reg_not_lisptag(ne,$3,$2))
260')
261
262define(`trap_unless_list',`
263        __(trap_unless_lisptag_equal($1,tag_list,$2))
264')
265
266define(`trap_unless_fixnum',`
267        __(test_fixnum($1))
268        __(uuo_error_reg_not_lisptag(ne,$1,tag_fixnum))
269        ')
270               
271define(`trap_unless_fulltag_equal',`
272        __(extract_fulltag($3,$1))
273        __(cmp $3,#$2)
274        __(uuo_error_reg_not_fulltag(ne,$1,$2))
275')
276       
277define(`trap_unless_typecode_equal',`
278        __(extract_typecode($3,$1))
279        __(cmp $3,#$2)
280        __(uuo_error_reg_not_xtype(ne,$2))
281')
282       
283/* "jump" to the code-vector of the function in nfn. */
284define(`jump_nfn',`
285        __(ldr pc,[nfn,#_function.entrypoint])
286')
287
288/* "call the code-vector of the function in nfn. */
289define(`call_nfn',`
290        __(ldr lr,[nfn,#_function.entrypoint])
291        __(blx lr)
292')
293       
294
295/* "jump" to the function in fnames function cell. */
296define(`jump_fname',`
297        __(ldr nfn,[fname,#symbol.fcell])
298        __(jump_nfn())
299')
300
301/* call the function in fnames function cell. */
302define(`call_fname',`
303        __(ldr nfn,[fname,#symbol.fcell])
304        __(call_nfn())
305')
306
307define(`funcall_nfn',`
308        __(extract_typecode(imm0,nfn))
309        __(cmp imm0,#subtag_symbol)
310        __(moveq fname,nfn)
311        __(ldreq nfn,[fname,#symbol.fcell])
312        __(cmpne imm0,#subtag_function)
313        __(ldreq pc,[nfn,#_function.entrypoint])
314        __(uuo_error_not_callable(ne,nfn))
315
316')
317
318
319define(`mkcatch',`
320        new_macro_labels()
321        __(build_lisp_frame(imm0))
322        __(movc16(imm0,make_header(catch_frame.element_count,subtag_catch_frame)))
323        __(movs temp2,fn)
324        __(ldrne temp2,[temp2,_function.codevector])
325        __(ldr temp1,[rcontext,#tcr.last_lisp_frame])
326        __(ldr imm1,[rcontext,#tcr.catch_top])
327        /* imm2 is mvflag */
328        /* arg_z is tag */
329        __(ldr arg_x,[rcontext,#tcr.db_link])
330        __(ldr temp0,[rcontext,#tcr.xframe])
331        __(stmdb sp!,{imm0,imm1,imm2,arg_z,arg_x,temp0,temp1,temp2})
332        __(add imm0,sp,#fulltag_misc)
333        __(str imm0,[rcontext,#tcr.catch_top])
334        __(add lr,lr,#4)
335')     
336
337
338       
339define(`check_stack_alignment',`
340        new_macro_labels()
341        __(andi. $1,sp,STACK_ALIGN_MASK)
342        __(beq+ macro_label(stack_ok))
343        __(.long 0)
344macro_label(stack_ok):
345')
346
347define(`stack_align',`((($1)+STACK_ALIGN_MASK)&~STACK_ALIGN_MASK)')
348
349define(`clear_alloc_tag',`
350        __(bic allocptr,allocptr,#fulltagmask)
351')
352
353define(`Cons',`
354        __(add allocptr,allocptr,#-cons.size+fulltag_cons)
355        __(ldr allocbase,[rcontext,#tcr.save_allocbase])
356        __(cmp allocptr,allocbase)
357        __(uuo_alloc_trap(lo))
358        __(str $3,[allocptr,#cons.cdr])
359        __(str $2,[allocptr,#cons.car])
360        __(mov $1,allocptr)
361        __(clear_alloc_tag())
362')
363
364
365/* This is probably only used once or twice in the entire kernel, but */
366/* I wanted a place to describe the constraints on the mechanism. */
367
368/* Those constaints are (not surprisingly) similar to those which apply */
369/* to cons cells, except for the fact that the header (and any length */
370/* field that might describe large arrays) has to have been stored in */
371/* the object if the trap has succeeded on entry to the GC.  It follows */
372/* that storing the register containing the header must immediately */
373/* follow the allocation trap (and an auxiliary length register must */
374/* be stored immediately after the header.)  Successfully falling */
375/* through the trap must emulate any header initialization: it would */
376/* be a bad idea to have allocptr pointing to a zero header ... */
377
378
379
380/* Parameters: */
381
382/* $1 = dest reg */
383/* $2 = header.
384/* $3 = register containing size in bytes.  (We're going to subtract */
385/* fulltag_misc from this; do it in the macro body, rather than force the
386/* (1 ?) caller to do it. */
387
388
389define(`Misc_Alloc',`
390        __(sub $3,$3,#fulltag_misc)
391        __(sub allocptr,allocptr,$3)
392        __(ldr allocbase,[rcontext,#tcr.save_allocbase])
393        __(cmp allocptr,allocbase)
394        __(uuo_alloc_trap(lo))
395        __(str $2,[allocptr,#misc_header_offset])
396        __(mov $1,allocptr)
397        __(clear_alloc_tag())
398')
399
400/*  Parameters $1, $2 as above; $3 = physical size constant. */
401define(`Misc_Alloc_Fixed',`
402        __(add allocptr,allocptr,#(-$3)+fulltag_misc)
403        __(ldr allocbase,[rcontext,#tcr.save_allocbase])
404        __(cmp allocptr,allocbase)
405        __(uuo_alloc_trap(lo))
406        __(str $2,[allocptr,#misc_header_offset])
407        __(mov $1,allocptr)
408        __(clear_alloc_tag())
409')
410
411/* Stack-allocate an ivector; $1 = header, $0 = dnode-aligned
412   size in bytes. */
413define(`stack_allocate_ivector',`
414        __(str $1,[sp,-$2]!)
415        ')
416       
417                       
418/* Stack-allocate an ivector and zero its contents; caller may
419   change subtag of header after it's zeroed.
420   $1 = header (tagged as subtag_u32_vector until zeroed), $2 = dnode-
421   aligned size in bytes).  Both $1 and $2 are modified here. */
422define(`stack_allocate_zeroed_ivector',`
423       new_macro_labels()
424        __(str $1,[sp,-$2]!)
425        __(mov $1,#0)
426        __(add $2,sp,$2)
427        __(b macro_label(test))
428macro_label(loop):     
429        __(str $1,[$2])
430macro_label(test):                     
431        __(sub $2,#dnode_size)
432        __(cmp $2,sp)
433        __(str $1,[$2,#node_size])
434        __(bne macro_label(loop))
435        ')
436   
437
438define(`check_enabled_pending_interrupt',`
439        __(ldr $1,[rcontext,#tcr.interrupt_pending])
440        __(cmp $1,0)
441        __(uuo_interrupt_now(gt))
442        ')
443       
444define(`check_pending_interrupt',`
445        new_macro_labels()
446        __(ldr $1,[rcontext,#tcr.tlb_pointer])
447        __(ldr $1,[$1,$INTERRUPT_LEVEL_BINDING_INDEX])
448        __(cmp $1,#0)
449        __(blt macro_label(done))
450        __(check_enabled_pending_interrupt($1))
451macro_label(done):
452')
453
454/* $1 = ndigits.  Assumes 4-byte digits */       
455define(`aligned_bignum_size',`((~(dnode_size-1)&(node_size+(dnode_size-1)+(4*$1))))')
456
457define(`suspend_now',`
458        __(uuo_suspend_now(al))
459')
460
461/* $3 points to a uvector header.  Set $1 to the first dnode-aligned address */
462/* beyond the uvector, using imm regs $1 and $2 as temporaries. */
463define(`skip_stack_vector',`
464        new_macro_labels()
465        __(ldr $1,[$3])
466        __(extract_fulltag($2,$1))       
467        __(cmp $2,#fulltag_immheader)
468        __(extract_lowbyte($2,$1))
469        __(mov $1,$1,lsr #num_subtag_bits)
470        __(moveq $1,$1,lsl #2)
471        __(beq macro_label(bytes))
472        __(cmp $2,#max_32_bit_ivector_subtag)
473        __(movle $1,$1,lsl #2)
474        __(ble macro_label(bytes))
475        __(cmp $2,#max_8_bit_ivector_subtag)
476        __(ble macro_label(bytes))
477        __(cmp $2,#max_16_bit_ivector_subtag)
478        __(movle $1,$1,lsl #1)
479        __(ble macro_label(bytes))
480        __(cmp $2,subtag_double_float_vector)
481        __(moveq $1,$1,lsl #3)
482        __(addeq $1,$1,#4)
483        __(beq macro_label(bytes))
484        __(add $1,$1,#7)
485        __(mov $1,$1,lsr #3)
486macro_label(bytes):     
487        __(add $1,$1,#node_size+(dnode_size-1))
488        __(bic $1,$1,#fulltagmask)
489        __(add $1,$1,$3)
490        ')
491
492/* This may need to be inlined.  $1=link, $2=saved sym idx, $3 = tlb, $4 = value */
493define(`do_unbind_to',`
494        __(ldr $1,[rcontext,#tcr.db_link])
495        __(ldr $3,[rcontext,#tcr.tlb_pointer])
4961:      __(ldr $2,[$1,#binding.sym])
497        __(ldr $4,[$1,#binding.val])
498        __(ldr $1,[$1,#binding.link])
499        __(cmp imm0,$1)
500        __(str $4,[$3,$2])
501        __(bne 1b)
502        __(str $1,[rcontext,#tcr.db_link])
503        ')               
504
Note: See TracBrowser for help on using the repository browser.