source: trunk/ccl/lisp-kernel/macros.s @ 557

Last change on this file since 557 was 557, checked in by gb, 15 years ago

PPC64 changes (some of them rather suspect ...). 32-bit kernel may be a
little funky ...

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 15.8 KB
Line 
1/*
2   Copyright (C) 1994-2001 Digitool, Inc
3   This file is part of OpenMCL. 
4
5   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
6   License , known as the LLGPL and distributed with OpenMCL as the
7   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
8   which is distributed with OpenMCL as the file "LGPL".  Where these
9   conflict, the preamble takes precedence. 
10
11   OpenMCL 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/* The assembler has to do the arithmetic here:  the expression
18   may not be evaluable by m4.
19*/
20define([lwi],[ifdef([DARWIN],[
21        .if ((($2) & 0xffff8000) == 0xffff8000)
22         li $1,($2)
23        .elseif ((($2) & 0xffff8000) == 0)
24         li $1,$2
25        .else
26         lis $1,(($2)>>16)
27         .if (($2) & 0xffff) <> 0
28          ori $1,$1,(($2) & 0xffff)
29         .endif
30        .endif],[
31        .ifeq (($2) & 0xffff8000)-0xffff8000
32         li $1,$2
33        .else
34         .ifeq (($2) & 0xffff8000)
35          li $1,$2
36         .else
37          lis $1,($2>>16)
38          .ifne ($2 & 0xffff)
39           ori $1,$1,$2 & 0xffff
40          .endif
41         .endif
42        .endif
43])])
44
45ifdef([PPC64],[
46        define([clrrri],[
47        clrrdi $@
48        ])       
49        define([clrlri],[
50        clrldi $@
51        ])
52        define([clrlri_],[
53        clrldi. $@
54        ])
55        define([ldr],[
56        ld $@
57        ])
58        define([ldrx],[
59        ldx $@
60        ])
61        define([ldru],[
62        ldu $@
63        ])
64        define([str],[
65        std $@
66        ])
67        define([strx],[
68        stdx $@
69        ])
70        define([stru],[
71        stdu $@
72        ])
73        define([strux],[
74        stdux $@
75        ])     
76        define([cmpr],[
77        cmpd $@
78        ])
79        define([cmpri],[
80        cmpdi $@
81        ])
82        define([cmplr],[
83        cmpld $@
84        ])
85        define([cmplri],[
86        cmpldi $@
87        ])
88        define([trlge],[
89        tdlge $@
90        ])
91        define([trllt],[
92        tdllt $@
93        ])
94        define([trlle],[
95        tdlle $@
96        ])
97        define([treqi],[
98        tdeqi $@
99        ])
100        define([trnei],[
101        tdnei $@
102        ])
103        define([trgti],[
104        tdgti $@
105        ])
106        define([srari],[
107        sradi $@
108        ])
109        define([srri],[
110        srdi $@
111        ])
112        define([slri],[
113        sldi $@
114        ])
115],[
116        define([clrrri],[
117        clrrwi $@
118        ])
119        define([clrlri],[
120        clrlwi $@
121        ])
122        define([clrlri_],[
123        clrlwi. $@
124        ])
125        define([ldr],[
126        lwz $@
127        ])
128        define([ldrx],[
129        lwzx $@
130        ])
131        define([ldru],[
132        lwzu $@
133        ])
134        define([str],[
135        stw $@
136        ])
137        define([strx],[
138        stwx $@
139        ])
140        define([stru],[
141        stwu $@
142        ])
143        define([strux],[
144        stwux $@
145        ])
146        define([cmpr],[
147        cmpw $@
148        ])
149        define([cmpri],[
150        cmpwi $@
151        ])
152        define([cmplr],[
153        cmplw $@
154        ])
155        define([cmplri],[
156        cmplwi $@
157        ])
158        define([trlge],[
159        twlge $@
160        ])
161        define([trllt],[
162        twllt $@
163        ])
164        define([trlle],[
165        twlle $@
166        ])       
167        define([treqi],[
168        tweqi $@
169        ])
170        define([trnei],[
171        twnei $@
172        ])
173        define([trgti],[
174        twgti $@
175        ])
176        define([srari],[
177        srawi $@
178        ])
179        define([srri],[
180        srwi $@
181        ])
182        define([slri],[
183        slwi $@
184        ])       
185])
186
187/*
188        dnode_align(dest,src,delta)
189*/
190        define([dnode_align],[
191        la $1,($3+(dnode_size-1))($2)
192        clrrri($1,$1,dnode_align_bits)
193])
194
195define([extract_fulltag],[
196        clrlri($1,$2,nbits_in_word-ntagbits)
197        ])
198
199define([extract_lisptag],[
200        clrlri($1,$2,nbits_in_word-nlisptagbits)
201        ])
202
203define([extract_lisptag_],[
204        clrlri_($1,$2,nbits_in_word-nlisptagbits)
205        ])
206
207define([extract_subtag],[
208        lbz $1,misc_subtag_offset($2)])
209
210define([extract_lowbyte],[
211        clrlwi $1,$2,nbits_in_word-num_subtag_bits])
212
213define([extract_header],[
214        ldr($1,misc_header_offset($2))])
215
216
217ifdef([PPC64],[
218define([extract_typecode],[
219        new_macro_labels()
220        extract_fulltag($1,$2)
221        cmpdi cr0,$1,fulltag_misc
222        extract_lisptag($1,$1)
223        bne cr0,macro_label(not_misc)
224        extract_subtag($1,$2)
225macro_label(not_misc):
226])],[   
227define([extract_typecode],[
228        new_macro_labels()
229        extract_lisptag($1,$2)
230        cmpwi cr0,$1,tag_misc
231        bne cr0,macro_label(not_misc)
232        extract_subtag($1,$2)
233macro_label(not_misc):
234])])
235
236define([box_fixnum],[
237        slri($1,$2,fixnumshift)])
238
239define([unbox_fixnum],[ 
240        srari($1,$2,fixnumshift)])
241
242define([loaddf],[
243        lfd $1,dfloat.value($2)])
244       
245define([storedf],[
246        stfd $1,dfloat.value($2)])
247
248define([push],[
249        stru($1,-node_size($2))])
250       
251        /* Generally not a great idea. */
252define([pop],[
253        ldr($1,0($2))
254        la $2,node_size($2)])
255       
256define([vpush],[
257        push($1,vsp)])
258       
259define([vpop],[
260        pop($1,vsp)])
261       
262               
263define([unlink],[
264        ldr($1,0($1))
265 ])
266
267       
268define([set_nargs],[
269        lwi(nargs,($1)<<fixnumshift)])
270       
271define([bitclr],[
272        rlwinm $1,$2,0,0x1f&((31-($3))+1),0x1f&((31-($3))-1)])
273       
274
275define([vref32],[
276        lwz $1,misc_data_offset+(($3)<<2)($2)])
277       
278define([vref16],[/* dest,src,n*/
279        lhz $1,misc_data_offset+(($3)<<1)($2)])
280       
281ifdef([PPC64],[
282        define([vref64],[
283        ld $1,misc_data_offset+(($3)<<3)($2)])
284
285        define([vrefr],[
286        vref64($1,$2,$3)])
287],[
288        define([vrefr],[
289        vref32($1,$2,$3)])
290])
291       
292                       
293define([getvheader],[
294        ldr($1,vector.header($2))])
295       
296        /* Size is unboxed element count */
297define([header_size],[
298        srri($1,$2,num_subtag_bits)])
299       
300        /* "Length" is fixnum element count */
301define([header_length],[
302ifdef([PPC64],[
303        clrlsldi $1,$2,nbits_in_word-num_subtag_bits,fixnum_shift
304        ],[               
305        rlwinm $1,$2,nbits_in_word-(num_subtag_bits-nfixnumtagbits),(num_subtag_bits-nfixnumtagbits),31-nfixnumtagbits
306        ])
307])       
308
309
310define([vector_size],[
311        getvheader(ifelse($3.[],$1,$3),$2)
312        header_size($1,ifelse($3.[],$1,$3))])
313       
314define([vector_length],[
315        getvheader($3,$2)
316        header_length($1,$3)])
317
318       
319define([ref_global],[
320        ldr($1,lisp_globals.$2(0))
321])
322
323define([set_global],[
324        str($1,lisp_globals.$2(0))
325])
326
327define([ref_nrs_value],[
328        ldr($1,((nrs.$2)+(symbol.vcell))(0))
329])
330       
331define([set_nrs_value],[
332        str($1,((nrs.$2)+(symbol.vcell))(0))
333])
334
335define([extract_unsigned_byte_bits],[
336        rlwinm $1,$2,0,32-fixnumshift,31-($3+fixnumshift)
337])
338
339define([extract_unsigned_byte_bits_],[/* dest,src,width*/
340        rlwinm. $1,$2,0,32-fixnumshift,31-($3+fixnumshift)
341])
342
343        /* vpop argregs - nargs is known to be non-zero */
344define([vpop_argregs_nz],[
345        new_macro_labels()
346        cmplri(cr1,nargs,node_size*2)
347        vpop(arg_z)
348        blt cr1,macro_label(l0)
349        vpop(arg_y)
350        bne cr1,macro_label(l0)
351        vpop(arg_x)
352macro_label(l0):])
353
354               
355        /* vpush argregs */
356define([vpush_argregs],[
357        new_macro_labels()
358        cmplri(cr0,nargs,0)
359        cmplri(cr1,nargs,node_size*2)
360        beq cr0,macro_label(done)
361        blt cr1,macro_label(z)
362        beq cr1,macro_label(yz)
363        vpush(arg_x)
364macro_label(yz):
365        vpush(arg_y)
366macro_label(z):
367        vpush(arg_z)
368macro_label(done):
369])
370
371define([create_lisp_frame],[
372        stru(sp,-lisp_frame.size(sp))
373])
374
375               
376define([build_lisp_frame],[
377        create_lisp_frame()
378        str(ifelse($1,[],fn,$1),lisp_frame.savefn(sp))
379        str(ifelse($2,[],loc_pc,$2),lisp_frame.savelr(sp))
380        str(ifelse($3,[],vsp,$3),lisp_frame.savevsp(sp))
381])
382
383               
384define([discard_lisp_frame],[
385        la sp,lisp_frame.size(sp)])
386       
387       
388define([_car],[
389        ldr($1,cons.car($2))
390])
391       
392define([_cdr],[
393        ldr($1,cons.cdr($2))])
394       
395define([rplaca],[
396        str($2,cons.car($1))])
397       
398define([rplacd],[
399        str($2,cons.cdr($1))])
400
401define([vpush_saveregs],[
402        vpush(save7)
403        vpush(save6)
404        vpush(save5)
405        vpush(save4)
406        vpush(save3)
407        vpush(save2)
408        vpush(save1)
409        vpush(save0)])
410       
411define([restore_saveregs],[
412        ldr(save0,node_size*0($1))
413        ldr(save1,node_size*1($1))
414        ldr(save2,node_size*2($1))
415        ldr(save3,node_size*3($1))
416        ldr(save4,node_size*4($1))
417        ldr(save5,node_size*5($1))
418        ldr(save6,node_size*6($1))
419        ldr(save7,node_size*7($1))
420])
421
422define([vpop_saveregs],[
423        restore_saveregs(vsp)
424        la vsp,node_size*8(vsp)])
425
426define([trap_unless_lisptag_equal],[
427        extract_lisptag($3,$1)
428        trnei($3,$2)
429])
430
431ifdef([PPC64],[
432define([trap_unless_list],[
433        new_macro_labels()
434        cmpdi ifelse($3,$3,cr0),$1,nil_value
435        extract_fulltag($2,$1)
436        beq ifelse($3,$3,cr0),macro_label(is_list)
437        twnei $2,fulltag_cons
438macro_label(is_list):   
439
440])],[   
441define([trap_unless_list],[
442        trap_unless_lisptag_equal($1,tag_list,$2)
443])
444])
445
446define([trap_unless_fulltag_equal],[
447        extract_fulltag($3,$1)
448        trnei($3,$2)
449])
450       
451define([trap_unless_typecode_equal],[
452        extract_typecode($3,$1)
453        trnei($3,$2)
454])
455       
456/* "jump" to the code-vector of the function in nfn. */
457define([jump_nfn],[
458        ldr(temp0,_function.codevector(nfn))
459        mtctr temp0
460        bctr
461])
462
463/* "call the code-vector of the function in nfn. */
464define([call_nfn],[
465        ldr(temp0,_function.codevector(nfn))
466        mtctr temp0
467        bctrl
468])
469       
470
471/* "jump" to the function in fnames function cell. */
472define([jump_fname],[
473        ldr(nfn,symbol.fcell(fname))
474        jump_nfn()
475])
476
477/* call the function in fnames function cell. */
478define([call_fname],[
479        ldr(nfn,symbol.fcell(fname))
480        call_nfn()
481])
482
483define([do_funcall],[
484        new_macro_labels()
485        extract_fulltag(imm0,temp0)
486        cmpri(imm0,fulltag_misc)
487        mr nfn,temp0
488        bne- macro_label(bad)
489        extract_subtag(imm0,temp0)
490        cmpri(imm0,subtag_function)
491        cmpri(cr1,imm0,subtag_symbol)
492        bne cr0,macro_label(_sym)
493        jump_nfn()
494macro_label(_sym):             
495        mr fname,temp0
496        bne cr1,macro_label(bad)
497        jump_fname()
498macro_label(bad):
499        uuo_interr(error_cant_call,temp0)
500])     
501
502define([mkcatch],[
503        mflr loc_pc
504        ldr(imm0,tcr.catch_top(rcontext))
505        lwz imm1,0(loc_pc) /* a forward branch to the catch/unwind cleanup */
506        rlwinm imm1,imm1,0,6,29 /* extract LI */
507        add loc_pc,loc_pc,imm1
508        build_lisp_frame(fn,loc_pc,vsp)
509        sub loc_pc,loc_pc,imm1
510        la loc_pc,4(loc_pc)     /* skip over the forward branch */
511        mtlr loc_pc
512        TSP_Alloc_Fixed_Boxed(catch_frame.size)
513        la imm1,tsp_frame.data_offset+fulltag_misc(tsp)
514        str(arg_z,catch_frame.catch_tag(imm1))
515        str(imm0,catch_frame.link(imm1))
516        str(imm2,catch_frame.mvflag(imm1))
517        ldr(imm0,tcr.db_link(rcontext))
518        str(sp,catch_frame.csp(imm1))
519        lwi(imm2,(catch_frame.element_count<<num_subtag_bits)|subtag_catch_frame)
520        str(imm0,catch_frame.db_link(imm1))
521        stmw first_nvr,catch_frame.regs(imm1)
522        str(imm2,catch_frame.header(imm1))
523        ldr(imm0,tcr.xframe(rcontext))
524        str(imm0,catch_frame.xframe(imm1))
525        str(rzero,catch_frame.tsp_segment(imm1))
526        str(imm1,tcr.catch_top(rcontext))
527        blr
528])     
529
530
531
532define([DCBZL],[
533        .long (31<<26)+(1<<21)+($1<<16)+($2<<11)+(1014<<1)
534])
535       
536define([check_stack_alignment],[
537        new_macro_labels()
538        andi. $1,sp,STACK_ALIGN_MASK
539        beq+ macro_label(stack_ok)
540        .long 0
541macro_label(stack_ok):
542])
543
544define([stack_align],[((($1)+STACK_ALIGN_MASK)&~STACK_ALIGN_MASK)])
545
546define([clear_alloc_tag],[
547        clrrwi allocptr,allocptr,ntagbits
548])
549
550/* If the GC interrupts the current thread (after the trap), it needs
551   to ensure that the cons cell that's been "reserved" stays reserved
552   (e.g. the tagged allocptr has to be treated as a node.)  If that
553   reserved cons cell gets tenured, the car and cdr are of a generation
554   that's at least as old (so memoization isn't an issue.)
555
556   More generally, if the GC interrupts a thread when allocptr is
557   tagged as a cons:
558
559    a) if the trap hasn't been taken (yet), the GC should force the
560       thread to resume in such a way that the trap will be taken ;
561       the segment allocator should worry about allocating the object.
562
563    b) If the trap has been taken, allocptr is treated as a node as
564       described above.  Allocbase is made to point to the base of the
565       cons cell, so that the thread's next allocation attempt will
566       invoke the segment allocator.
567*/
568       
569define([Cons],[
570        la allocptr,(-cons.size+fulltag_cons)(allocptr)
571        trllt(allocptr,allocbase)
572        str($3,cons.cdr(allocptr))
573        str($2,cons.car(allocptr))
574        mr $1,allocptr
575        clear_alloc_tag()
576])
577
578/*
579  This is probably only used once or twice in the entire kernel, but
580  I wanted a place to describe the constraints on the mechanism.
581
582  Those constaints are (not surprisingly) similar to those which apply
583  to cons cells, except for the fact that the header (and any length
584  field that might describe large arrays) has to have been stored in
585  the object if the trap has succeeded on entry to the GC.  It follows
586  that storing the register containing the header must immediately
587  follow the allocation trap (and an auxiliary length register must
588  be stored immediately after the header.)  Successfully falling
589  through the trap must emulate any header initialization: it would
590  be a bad idea to have allocptr pointing to a zero header ...
591*/
592
593/*
594  Parameters:   
595
596  $1 = dest reg
597  $2 = header.  (For now, assume that this always encodes length ;
598        that may change with "large vector" support.)
599  $3 = register containing size in bytes.  (We're going to subtract
600        fulltag_misc from this; do it in the macro body, rather than force the          (1 ?) caller to do it.
601*/
602
603define([Misc_Alloc],[
604        la $3,-fulltag_misc($3)
605        sub allocptr,allocptr,$3
606        trllt(allocptr,allocbase)
607        str($2,misc_header_offset(allocptr))
608        mr $1,allocptr
609        clear_alloc_tag()
610])
611
612/*
613  Parameters $1, $2 as above; $3 = physical size constant.
614*/
615define([Misc_Alloc_Fixed],[
616        la allocptr,(-$3)+fulltag_misc(allocptr)
617        trllt(allocptr,allocbase)
618        str($2,misc_header_offset(allocptr))
619        mr $1,allocptr
620        clear_alloc_tag()
621])
622
623
624/*
625  Zero $3 bytes worth of doublewords, starting at offset $2 relative
626  to the base register $1.
627*/
628
629ifdef([DARWIN],[
630        .macro zero_doublewords
631        .if $2
632        stfd fp_zero,$1($0)
633        zero_doublewords $0,$1+8,$2-8
634        .endif
635        .endmacro
636])
637
638ifdef([LINUX],[
639        .macro zero_doublewords base,disp,nbytes
640        .if \nbytes
641        stfd fp_zero,\disp(\base)
642        zero_doublewords \base,\disp+8,\nbytes-8
643        .endif
644        .endm
645])     
646
647define([Set_TSP_Frame_Unboxed],[
648        str(tsp,tsp_frame.type(tsp))
649])
650
651define([Set_TSP_Frame_Boxed],[
652        str(rzero,tsp_frame.type(tsp))
653])
654               
655/*
656  A newly allocated TSP frame is always "raw" (has non-zero type, indicating
657  that it doesn't contain tagged data.
658*/
659define([TSP_Alloc_Fixed_Unboxed],[
660        stwu tsp,-($1+tsp_frame.data_offset)(tsp)
661        Set_TSP_Frame_Unboxed()
662])
663
664define([TSP_Alloc_Fixed_Unboxed_Zeroed],[
665        TSP_Alloc_Fixed_Unboxed($1)
666        zero_doublewords tsp,tsp_frame.fixed_overhead,$1
667])
668
669define([TSP_Alloc_Fixed_Boxed],[
670        TSP_Alloc_Fixed_Unboxed_Zeroed($1)
671        Set_TSP_Frame_Boxed()
672])
673       
674/*
675  This assumes that the backpointer points  to the first byte beyond
676  each frame.  If we allow segmented tstacks, that constraint might
677  complicate  their implementation.
678  We don't need to know the size of the frame (positive or negative,
679  with or without header).  $1 and $2 are temp registers, $3 is an
680  optional CR field.
681*/
682
683/* Handle the general case, where the frame might be empty */
684define([Zero_TSP_Frame],[
685        new_macro_labels()
686        mr $1,tsp
687        ldr($2,tsp_frame.backlink(tsp))
688        la $2,-8($2)
689        b macro_label(zero_tsp_test)
690macro_label(zero_tsp_loop):
691        stfdu fp_zero,8($1)
692macro_label(zero_tsp_test):     
693        cmpr(ifelse($3,[],[cr0],$3),$1,$2)
694        bne ifelse($3,[],[cr0],$3),macro_label(zero_tsp_loop)
695])
696
697/* Save some branching when we know that the frame can't be empty.*/
698define([Zero_TSP_Frame_nz],[
699        new_macro_labels()
700        mr $1,tsp
701        ldr($2,tsp_frame.backlink(tsp))
702        la $2,-8($2)
703macro_label(zero_tsp_loop):
704        stfdu fp_zero,8($1)
705        cmpr(ifelse($3,[],[cr0],$3),$1,$2)
706        bne ifelse($3,[],[cr0],$3),macro_label(zero_tsp_loop)
707])
708       
709/* $1 = 8-byte-aligned size, positive.  $2 (optiional) set
710   to negated size. */
711define([TSP_Alloc_Var_Unboxed],[
712        neg ifelse($2,[],$1,$2),$1
713        strux(tsp,tsp,ifelse($2,[],$1,$2))
714        Set_TSP_Frame_Unboxed()
715])
716
717define([TSP_Alloc_Var_Boxed],[
718        TSP_Alloc_Var_Unboxed($1)
719        Zero_TSP_Frame($1,$2)
720        Set_TSP_Frame_Boxed()
721])             
722
723
724define([TSP_Alloc_Var_Boxed_nz],[
725        TSP_Alloc_Var_Unboxed($1)
726        Zero_TSP_Frame_nz($1,$2)
727        Set_TSP_Frame_Boxed()
728])             
729
730define([check_pending_interrupt],[
731        new_macro_labels()
732        ldr(nargs,tcr.interrupt_level(rcontext))
733        cmpri(ifelse($1,[],[cr0],$1),nargs,0)
734        blt ifelse($1,[],[cr0],$1),macro_label(done)
735        bgt ifelse($1,[],[cr0],$1),macro_label(trap)
736        ldr(nargs,tcr.interrupt_pending(rcontext))
737macro_label(trap):
738        trgti(nargs,0)
739macro_label(done):
740])
741
Note: See TracBrowser for help on using the repository browser.