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

Last change on this file since 528 was 528, checked in by gb, 16 years ago

More portability stuff; still a ways to go.

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