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

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

Some new files (just started to define things based on ppc32 versions,
tried to pick off low-hanging fruit) and changes. (Way too early to
consider changes significant.)

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/* The assembler has to do the arithmetic here:  the expression */
17/*   may not be evaluable by m4. */
18
19
20
21
22/* dnode_align(dest,src,delta) */
23        define(`dnode_align',`
24        __(add $1,[$2,#(dnode_size-1)])
25        __(bic $1,$1,#((1<<dnode_align_bits)-1))
26')
27
28define(`extract_fulltag',`
29        __(and $1,$1,#((1<<ntagbits)-1))
30        ')
31
32define(`extract_lisptag',`
33        __(and $1,$1,#((1<<nlisptagbits)-1))
34        ')
35
36define(`extract_lisptag_',`
37        __(ands $1,$1,#((1<<nlisptagbits)-1))
38        ')
39
40define(`extract_subtag',`
41        __(ldrb $1,[$2,#misc_subtag_offset])
42        ')
43
44                               
45define(`extract_lowbyte',`
46        __(and $1,$2,#((1<<num_subtag_bits)-1))
47        ')
48
49define(`extract_header',`
50        __(ldr $1,[$2,#misc_header_offset])
51        ')
52
53define(`extract_typecode',`
54        __(extract_lisptag($1,$2))
55        __(cmp $1,#fulltag_misc)
56        __(ldrbeq $1,[$2,#misc_subtag_offset])
57        ')
58
59define(`box_fixnum',`
60        __(mov #1,$2, lsl #fixnumshift)
61        ')
62
63define(`unbox_fixnum',`
64        __(mov $1,$2, asr #fixnumshift)
65        ')
66
67define(`loaddf',`
68        __(lfd $1,dfloat.value($2))')
69       
70define(`storedf',`
71        __(stfd $1,dfloat.value($2))
72        ')
73
74define(`push1',`
75        __(str $1,[$2,#-node_size]!)
76        ')
77       
78        /* Generally not a great idea. */
79define(`pop1',`
80        __(ldr $1,[$2],#node_size)
81        ')
82       
83define(`vpush1',`
84        __(push1($1,vsp))
85        ')
86       
87define(`vpop1',`
88        __(pop1($1,vsp))
89        ')
90       
91               
92define(`unlink',`
93        __(ldr($1,0($1)))
94 ')
95
96       
97define(`set_nargs',`
98        __(lwi(nargs,($1)<<fixnumshift))
99        ')
100       
101define(`bitclr',`
102        __(rlwinm $1,$2,0,0x1f&((31-($3))+1),0x1f&((31-($3))-1))
103        ')
104       
105
106define(`vref32',`
107        __(ldr #1,[$2,#misc_data_offset+(($3)<<2)])
108        ')
109       
110define(`vref16',`/* dest,src,n*/
111        __(lhz $1,misc_data_offset+(($3)<<1)($2))
112        ')
113       
114define(`vrefr',`
115        __(vref32($1,$2,$3))
116        ')
117
118
119       
120                       
121define(`getvheader',`
122        __(ldr($1,vector.header($2)))
123        ')
124       
125       
126        /* "Length" is fixnum element count */
127define(`header_length',`
128        mov $1,#-1<<fixnumshift
129        and $1,$1,$2,lsr #num_subtag_bits-fixnumshift
130        ')
131')       
132
133
134define(`vector_length',`
135        __(getvheader($3,$2))
136        __(header_length($1,$3))
137        ')
138
139       
140define(`ref_global',`
141        __(ldr($1,lisp_globals.$2(0)))
142')
143
144define(`set_global',`
145        __(str($1,lisp_globals.$2(0)))
146')
147
148define(`ref_nrs_value',`
149        __(ldr($1,((nrs.$2)+(symbol.vcell))(0)))
150')
151       
152define(`set_nrs_value',`
153        __(str($1,((nrs.$2)+(symbol.vcell))(0)))
154')
155
156define(`extract_unsigned_byte_bits',`
157ifdef(`PPC64',`
158        __(rldicr $1,$2,64-fixnumshift,63-$3)
159',`               
160        __(rlwinm $1,$2,0,32-fixnumshift,31-($3+fixnumshift))
161')       
162')
163
164define(`extract_unsigned_byte_bits_',`
165ifdef(`PPC64',`
166        __(rldicr. $1,$2,64-fixnumshift,63-$3)
167',`               
168        __(rlwinm. $1,$2,0,32-fixnumshift,31-($3+fixnumshift))
169')       
170')
171
172        /* vpop argregs - nargs is known to be non-zero */
173define(`vpop_argregs_nz',`
174        __(cmp nargs,#node_size*2)
175        __(vpop1(arg_z))
176        __(ldrhs arg_y,[vsp],#node_size)
177        __(ldrhi arg_x,[vsp],#node_size)
178        ')
179
180               
181        /* vpush argregs */
182define(`vpush_argregs',`
183        new_macro_labels()
184        __(cmplri(cr0,nargs,0))
185        __(cmplri(cr1,nargs,node_size*2))
186        __(beq cr0,macro_label(done))
187        __(blt cr1,macro_label(z))
188        __(beq cr1,macro_label(yz))
189        __(vpush(arg_x))
190macro_label(yz):
191        __(vpush(arg_y))
192macro_label(z):
193        __(vpush(arg_z))
194macro_label(done):
195')
196
197define(`create_lisp_frame',`
198        __(stru(sp,-lisp_frame.size(sp)))
199')
200
201               
202define(`build_lisp_frame',`
203        create_lisp_frame()
204        __(str(ifelse($1,`',fn,$1),lisp_frame.savefn(sp)))
205        __(str(ifelse($2,`',loc_pc,$2),lisp_frame.savelr(sp)))
206        __(str(ifelse($3,`',vsp,$3),lisp_frame.savevsp(sp)))
207')
208
209               
210define(`discard_lisp_frame',`
211        __(la sp,lisp_frame.size(sp))
212        ')
213       
214       
215define(`_car',`
216        __(ldr $1,[$2,#cons.car])
217')
218       
219define(`_cdr',`
220        __(ldr $1,[$2,#cons.cdr])
221        ')
222       
223define(`_rplaca',`
224        __(str $2,[$1,#cons.car])
225        ')
226       
227define(`_rplacd',`
228        __(str $2,[$1,#cons.cdr])
229        ')
230
231
232define(`trap_unless_lisptag_equal',`
233        __(extract_lisptag($3,$1))
234        __(trnei($3,$2))
235')
236
237define(`trap_unless_list',`
238        __(trap_unless_lisptag_equal($1,tag_list,$2))
239')
240
241define(`trap_unless_fulltag_equal',`
242        __(extract_fulltag($3,$1))
243        __(trnei($3,$2))
244')
245       
246define(`trap_unless_typecode_equal',`
247        __(extract_typecode($3,$1))
248        __(trnei($3,$2))
249')
250       
251/* "jump" to the code-vector of the function in nfn. */
252define(`jump_nfn',`
253        __(ldr pc,[nfn,#_function.codevector])
254')
255
256/* "call the code-vector of the function in nfn. */
257define(`call_nfn',`
258        __(ldr lr,[nfn,#_function.codevector])
259        __(blx lr)
260')
261       
262
263/* "jump" to the function in fnames function cell. */
264define(`jump_fname',`
265        __(ldr nfn,[fname,#symbol.fcell])
266        __(jump_nfn())
267')
268
269/* call the function in fnames function cell. */
270define(`call_fname',`
271        __(ldr nfn,[fname,#symbol.fcell])
272        __(call_nfn())
273')
274
275define(`funcall_nfn',`
276        __(extract_typecode(imm0,nfn))
277        __(cmp imm0,#subtag_symbol)
278        __(moveq fname,nfn)
279        __(ldreq nfn,[fname,#symbol.fcell])
280        __(cmpne imm0,#subtag_function)
281        __(ldreq pc,[nfn,#_function.entrypoint])
282        __(uuo_error_cant_call(nfn,al))
283
284')     
285
286define(`mkcatch',`
287        __(mflr loc_pc)
288        __(ldr(imm0,tcr.catch_top(rcontext)))
289        __(lwz imm1,0(loc_pc)) /* a forward branch to the catch/unwind cleanup */
290        __(rlwinm imm1,imm1,0,6,29)     /* extract LI */
291        __(add loc_pc,loc_pc,imm1)
292        __(build_lisp_frame(fn,loc_pc,vsp))
293        __(sub loc_pc,loc_pc,imm1)
294        __(la loc_pc,4(loc_pc)) /* skip over the forward branch */
295        __(mtlr loc_pc)
296        __(lwi(imm4,(catch_frame.element_count<<num_subtag_bits)|subtag_catch_frame))
297        __(ldr(imm3,tcr.xframe(rcontext)))
298        __(ldr(imm1,tcr.db_link(rcontext)))
299        __(TSP_Alloc_Fixed_Unboxed(catch_frame.size))
300        __(la nargs,tsp_frame.data_offset+fulltag_misc(tsp))
301        __(str(imm4,catch_frame.header(nargs)))
302        __(str(arg_z,catch_frame.catch_tag(nargs)))
303        __(str(imm0,catch_frame.link(nargs)))
304        __(str(imm2,catch_frame.mvflag(nargs)))
305        __(str(sp,catch_frame.csp(nargs)))
306        __(str(imm1,catch_frame.db_link(nargs)))
307        __(str(first_nvr,catch_frame.regs+0*node_size(nargs)))
308        __(str(second_nvr,catch_frame.regs+1*node_size(nargs)))
309        __(str(third_nvr,catch_frame.regs+2*node_size(nargs)))
310        __(str(fourth_nvr,catch_frame.regs+3*node_size(nargs)))
311        __(str(fifth_nvr,catch_frame.regs+4*node_size(nargs)))
312        __(str(sixth_nvr,catch_frame.regs+5*node_size(nargs)))
313        __(str(seventh_nvr,catch_frame.regs+6*node_size(nargs)))
314        __(str(eighth_nvr,catch_frame.regs+7*node_size(nargs)))
315        __(str(imm3,catch_frame.xframe(nargs)))
316        __(str(rzero,catch_frame.tsp_segment(nargs)))
317        __(Set_TSP_Frame_Boxed())
318        __(str(nargs,tcr.catch_top(rcontext)))
319        __(li nargs,0)
320
321')     
322
323
324       
325define(`check_stack_alignment',`
326        new_macro_labels()
327        __(andi. $1,sp,STACK_ALIGN_MASK)
328        __(beq+ macro_label(stack_ok))
329        __(.long 0)
330macro_label(stack_ok):
331')
332
333define(`stack_align',`((($1)+STACK_ALIGN_MASK)&~STACK_ALIGN_MASK)')
334
335define(`clear_alloc_tag',`
336        __(bic allocptr,allocptr,#fulltagmask)
337')
338
339define(`Cons',`
340        __(ldr allocbase,[rcontext,#tcr.save_allocbase])
341        __(add allocptr,allocptr,#-cons.size+fulltag_cons)
342        __(cmp allocptr,allocbase)
343        __(uuo_alloc_trap(lo))
344        __(str $3,[allocptr,#cons.cdr])
345        __(str $2,[allocptr,#cons.car])
346        __(mov $1,allocptr)
347        __(clear_alloc_tag())
348')
349
350
351/* This is probably only used once or twice in the entire kernel, but */
352/* I wanted a place to describe the constraints on the mechanism. */
353
354/* Those constaints are (not surprisingly) similar to those which apply */
355/* to cons cells, except for the fact that the header (and any length */
356/* field that might describe large arrays) has to have been stored in */
357/* the object if the trap has succeeded on entry to the GC.  It follows */
358/* that storing the register containing the header must immediately */
359/* follow the allocation trap (and an auxiliary length register must */
360/* be stored immediately after the header.)  Successfully falling */
361/* through the trap must emulate any header initialization: it would */
362/* be a bad idea to have allocptr pointing to a zero header ... */
363
364
365
366/* Parameters: */
367
368/* $1 = dest reg */
369/* $2 = header.  (For now, assume that this always encodes length ; */
370/* that may change with "large vector" support.) */
371/* $3 = register containing size in bytes.  (We're going to subtract */
372/* fulltag_misc from this; do it in the macro body, rather than force the
373/* (1 ?) caller to do it. */
374
375
376define(`Misc_Alloc',`
377        __(la $3,-fulltag_misc($3))
378        __(sub allocptr,allocptr,$3)
379        __(alloc_trap())
380        __(str($2,misc_header_offset(allocptr)))
381        __(mr $1,allocptr)
382        __(clear_alloc_tag())
383')
384
385/*  Parameters $1, $2 as above; $3 = physical size constant. */
386define(`Misc_Alloc_Fixed',`
387        __(la allocptr,(-$3)+fulltag_misc(allocptr))
388        __(alloc_trap())
389        __(str($2,misc_header_offset(allocptr)))
390        __(mr $1,allocptr)
391        __(clear_alloc_tag())
392')
393
394
395/*  Zero $3 bytes worth of doublewords, starting at offset $2 relative */
396/* to the base register $1. */
397
398
399ifdef(`DARWIN',`
400        .macro zero_doublewords
401        .if $2
402        stfd fp_zero,$1($0)
403        zero_doublewords $0,$1+8,$2-8
404        .endif
405        .endmacro
406')
407
408ifdef(`LINUX',`
409        .macro zero_doublewords base,disp,nbytes
410        .if \nbytes
411        stfd fp_zero,\disp(\base)
412        zero_doublewords \base,\disp+8,\nbytes-8
413        .endif
414        .endm
415')     
416
417define(`Set_TSP_Frame_Unboxed',`
418        __(str(tsp,tsp_frame.type(tsp)))
419')
420
421define(`Set_TSP_Frame_Boxed',`
422        __(str(rzero,tsp_frame.type(tsp)))
423')
424               
425/* A newly allocated TSP frame is always "raw" (has non-zero type, indicating */
426/* that it doesn't contain tagged data. */
427
428define(`TSP_Alloc_Fixed_Unboxed',`
429        __(stru(tsp,-($1+tsp_frame.data_offset)(tsp)))
430        __(Set_TSP_Frame_Unboxed())
431')
432
433define(`TSP_Alloc_Fixed_Unboxed_Zeroed',`
434        __(TSP_Alloc_Fixed_Unboxed($1))
435        __(zero_doublewords tsp,tsp_frame.fixed_overhead,$1)
436')
437
438define(`TSP_Alloc_Fixed_Boxed',`
439        __(TSP_Alloc_Fixed_Unboxed_Zeroed($1))
440        __(Set_TSP_Frame_Boxed())
441')
442
443
444       
445       
446
447/* This assumes that the backpointer points  to the first byte beyond */
448/* each frame.  If we allow segmented tstacks, that constraint might */
449/* complicate  their implementation. */
450/* We don't need to know the size of the frame (positive or negative, */
451/* with or without header).  $1 and $2 are temp registers, $3 is an */
452/* optional CR field. */
453
454
455/* Handle the general case, where the frame might be empty */
456define(`Zero_TSP_Frame',`
457        __(new_macro_labels())
458        __(la $1,tsp_frame.size-8(tsp))
459        __(ldr($2,tsp_frame.backlink(tsp)))
460        __(la $2,-8($2))
461        __(b macro_label(zero_tsp_test))
462macro_label(zero_tsp_loop):
463        __(stfdu fp_zero,8($1))
464macro_label(zero_tsp_test):     
465        __(cmpr(ifelse($3,`',`cr0',$3),$1,$2))
466        __(bne ifelse($3,`',`cr0',$3),macro_label(zero_tsp_loop))
467')
468
469/* Save some branching when we know that the frame can't be empty.*/
470define(`Zero_TSP_Frame_nz',`
471        new_macro_labels()
472        __(la $1,tsp_frame.size-8(tsp))
473        __(ldr($2,tsp_frame.backlink(tsp)))
474        __(la $2,-8($2))
475macro_label(zero_tsp_loop):
476        __(stfdu fp_zero,8($1))
477        __(cmpr(ifelse($3,`',`cr0',$3),$1,$2))
478        __(bne ifelse($3,`',`cr0',$3),macro_label(zero_tsp_loop))
479')
480       
481/* $1 = 8-byte-aligned size, positive.  $2 (optiional) set */
482/* to negated size. */
483define(`TSP_Alloc_Var_Unboxed',`
484        __(neg ifelse($2,`',$1,$2),$1)
485        __(strux(tsp,tsp,ifelse($2,`',$1,$2)))
486        __(Set_TSP_Frame_Unboxed())
487')
488
489define(`TSP_Alloc_Var_Boxed',`
490        __(TSP_Alloc_Var_Unboxed($1))
491        __(Zero_TSP_Frame($1,$2))
492        __(Set_TSP_Frame_Boxed())
493')             
494
495
496define(`TSP_Alloc_Var_Boxed_nz',`
497        __(TSP_Alloc_Var_Unboxed($1))
498        __(Zero_TSP_Frame_nz($1,$2))
499        __(Set_TSP_Frame_Boxed())
500')             
501
502define(`check_pending_interrupt',`
503        new_macro_labels()
504        __(ldr(nargs,tcr.tlb_pointer(rcontext)))
505        __(ldr(nargs,INTERRUPT_LEVEL_BINDING_INDEX(nargs)))
506        __(cmpri(ifelse($1,`',`cr0',$1),nargs,0))
507        __(blt ifelse($1,`',`cr0',$1),macro_label(done))
508        __(bgt ifelse($1,`',`cr0',$1),macro_label(trap))
509        __(ldr(nargs,tcr.interrupt_pending(rcontext)))
510macro_label(trap):
511        __(trgti(nargs,0))
512macro_label(done):
513')
514
515/* $1 = ndigits.  Assumes 4-byte digits */       
516define(`aligned_bignum_size',`((~(dnode_size-1)&(node_size+(dnode_size-1)+(4*$1))))')
517
518define(`suspend_now',`
519        __(uuo_interr(error_propagate_suspend,rzero))
520')
Note: See TracBrowser for help on using the repository browser.