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

Last change on this file since 14040 was 14040, checked in by gb, 10 years ago

movc16 macro expands to movw.

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