Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /MLRISC/trunk/amd64/staged-allocation/test.sml
ViewVC logotype

Diff of /MLRISC/trunk/amd64/staged-allocation/test.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

MLRISC/trunk/staged-allocation/test-staged-allocation-amd64.sml revision 3000, Tue Apr 22 08:01:00 2008 UTC MLRISC/trunk/amd64/staged-allocation/test.sml revision 3037, Tue May 27 06:30:07 2008 UTC
# Line 1  Line 1 
1    (*
2     * User defined constant type.  Dummy for now.
3     * In practice, you'll want to use this type to implement constants with
4     * values that cannot be determined until final code generation, e.g.
5     * stack frame offset.
6     *)
7    structure UserConst =
8    struct
9       type const = unit
10       fun toString() = ""
11       fun hash() = 0w0
12       fun valueOf _ = 0
13       fun == _ = true
14    end
15    
16    (*
17     * User defined datatype for representing aliasing.   Dummy for now.
18     * You'll need this to represent aliasing information.
19     *)
20    structure UserRegion =
21    struct
22       type region = unit
23       fun toString () = ""
24       val memory = ()
25       val stack = ()
26       val readonly = ()
27       val spill = ()
28    end
29    
30    (*
31     * User defined datatype for representing pseudo assembly operators.
32     * Dummy for now.
33     *
34     * You'll need this to represent assembler directives.
35     *)
36    structure UserPseudoOps =
37    struct
38       type pseudo_op = unit
39       fun toString () = ""
40       fun emitValue _ = ()
41       fun sizeOf _ = 0
42       fun adjustLabels _ = true
43    end
44    
45    
46    
47    (*
48     * Client defined extensions.  None for now.
49     * You'll need this only if you need to extend the set of MLTREE operators
50     *)
51    structure UserExtension =
52    struct
53    
54       type ('s,'r,'f,'c) sx = ('s,'r,'f,'c) AMD64InstrExt.sext
55       type ('s,'r,'f,'c) rx = unit
56       type ('s,'r,'f,'c) fx = unit
57       type ('s,'r,'f,'c) ccx = unit
58    
59    end
60    
61    (*
62     * This module controls how we handle user extensions.  Since we don't
63     * have any yet.  This is just a bunch of dummy routines.
64     *)
65    functor UserMLTreeExtComp
66                (    structure I : AMD64INSTR where T.Extension = UserExtension
67        structure TS : MLTREE_STREAM where T = I.T
68        structure CFG : CONTROL_FLOW_GRAPH where I = I and P = TS.S.P
69       ) : MLTREE_EXTENSION_COMP =
70    struct
71        structure T = TS.T
72        structure TS = TS
73        structure I = I
74        structure CFG = CFG
75        structure C = I.C
76    
77        structure CompInstrExt = AMD64CompInstrExt (
78          structure I = I
79          structure TS = TS
80          structure CFG = CFG)
81    
82        type reducer =
83              (I.instruction,C.cellset,I.operand,I.addressing_mode,CFG.cfg) TS.reducer
84    
85        val compileSext = CompInstrExt.compileSext
86    
87        fun compileRext _ = raise Fail "AMD64CompExtFn.compileRext"
88        fun compileFext _ = raise Fail "AMD64CompExtFn.compileFext"
89        fun compileCCext _ = raise Fail "AMD64CompExtFn.compileCCext"
90    
91    end
92    
93  val floats16ByteAligned = true  val floats16ByteAligned = true
94    
95  structure AMD64MLTree =  structure AMD64MLTree =
# Line 234  Line 326 
326      structure CFG=AMD64CFG      structure CFG=AMD64CFG
327      structure Shuffle = AMD64Shuffle)      structure Shuffle = AMD64Shuffle)
328    
329    structure CCalls2 = AMD64SVIDFn (
330                        structure T = AMD64MLTree)
331    
332  structure CCalls = AMD64SVID (  structure CCalls = AMD64SVID (
333             structure T = AMD64MLTree             structure T = AMD64MLTree
334             val frameAlign = 16)             val frameAlign = 16)
# Line 248  Line 343 
343       structure Rewrite =       structure Rewrite =
344         struct         struct
345           structure I = AMD64Instr           structure I = AMD64Instr
346           fun rewriteDef _ = raise Fail ""           structure C=I.C
347           fun rewriteUse _ = raise Fail ""           structure CB = CellsBasis
348             fun error msg = MLRiscErrorMsg.error("X86Rewrite", msg)
349    
350             fun operand (rs,rt) opnd =
351                 (case opnd
352                   of I.Direct (sz, r) => if CB.sameColor(r,rs) then I.Direct (sz, rt) else opnd
353                    | I.Displace{base, disp, mem} =>
354                      if CB.sameColor(base,rs) then I.Displace{base=rt, disp=disp, mem=mem}
355                      else opnd
356                    | I.Indexed{base as SOME b, index, scale, disp, mem} => let
357                          val base'= if CB.sameColor(b,rs) then SOME rt else base
358                          val index'=if CB.sameColor(index,rs) then rt else index
359                      in I.Indexed{base=base', index=index', scale=scale, disp=disp, mem=mem}
360                      end
361                    | I.Indexed{base, index, scale, disp, mem=mem}  =>
362                      if CB.sameColor(index,rs) then
363                          I.Indexed{base=base, index=rt, scale=scale, disp=disp, mem=mem}
364                      else opnd
365                    | _ => opnd
366                  (*end case*))
367    
368    
369             fun rewriteDef (instr, rs, rt) = let
370                 fun operand(opnd as I.Direct (sz, r)) =
371                     if CB.sameColor(r,rs) then I.Direct (sz, rt) else opnd
372                   | operand _ = error "operand: not I.Direct"
373                 fun replace r = if CB.sameColor(r,rs) then rt else r
374                 fun rewriteX86Def(instr) =
375                     (case instr
376                       of I.CALL{opnd, defs, uses, return, cutsTo, mem, pops} =>
377                          I.CALL{opnd=opnd, cutsTo=cutsTo,
378                                 return=CB.CellSet.map {from=rs,to=rt} return, pops=pops,
379                                 defs=CB.CellSet.map {from=rs,to=rt} defs, uses=uses, mem=mem}
380                        | I.MOVE{mvOp, src, dst} => I.MOVE{mvOp=mvOp, src=src, dst=operand dst}
381                        | I.LEAL{r32, addr} => I.LEAL{r32=replace r32, addr=addr}
382                        | I.LEAQ{r64, addr} => I.LEAQ{r64=replace r64, addr=addr}
383                        | I.BINARY{binOp, src, dst} =>
384                          I.BINARY{binOp=binOp, src=src, dst=operand dst}
385                        | I.SHIFT{shiftOp, src, dst, count} =>
386                          I.SHIFT{shiftOp=shiftOp, src=src, count=count, dst=operand dst}
387                        | I.UNARY{unOp, opnd} => I.UNARY{unOp=unOp, opnd=operand opnd}
388                        | I.SET{cond, opnd} => I.SET{cond=cond, opnd=operand opnd}
389                        | _ => instr
390                    (* end case *))
391    
392                 fun f (I.ANNOTATION{a,i}) =
393                     I.ANNOTATION{i=rewriteDef(i,rs,rt),
394                                  a=(case a of
395                                         CB.DEF_USE{cellkind=CB.GP,defs,uses} =>
396                                         CB.DEF_USE{cellkind=CB.GP,uses=uses,
397                                                    defs=map replace defs}
398                                       | _ => a)}
399                   | f (I.INSTR i) = I.INSTR(rewriteX86Def(i))
400                   | f (I.COPY{k as CB.GP, sz, dst, src, tmp}) =
401                     I.COPY{k=k, sz=sz, dst=map replace dst, src=src, tmp=tmp}
402             in
403                 f(instr)
404             end
405    
406    
407             fun rewriteUse (instr, rs, rt) = let
408                 val operand = operand (rs, rt)
409                 fun replace r = if CB.sameColor(r,rs) then rt else r
410                 fun rewrite instr = (case instr
411                     of I.JMP(opnd, labs) => I.JMP(operand opnd, labs)
412                      | I.JCC{cond, opnd} => I.JCC{cond=cond, opnd = operand opnd}
413                      | I.CALL{opnd, defs, uses, return, cutsTo, mem, pops} =>
414                        I.CALL{opnd=operand opnd, defs=defs, return=return,
415                               uses=CB.CellSet.map {from=rs,to=rt} uses, cutsTo=cutsTo,
416                               mem=mem, pops=pops}
417                      | I.MOVE{mvOp, src, dst as I.Direct _} =>
418                        I.MOVE{mvOp=mvOp, src=operand src, dst=dst}
419                      | I.MOVE{mvOp, src, dst} =>
420                        I.MOVE{mvOp=mvOp, src=operand src, dst=operand dst}
421                      | I.LEAL{r32, addr} => I.LEAL{r32=r32, addr=operand addr}
422                      | I.LEAQ{r64, addr} => I.LEAQ{r64=r64, addr=operand addr}
423                      | I.CMPL{lsrc, rsrc} => I.CMPL{lsrc=operand lsrc, rsrc=operand rsrc}
424                      | I.CMPW{lsrc, rsrc} => I.CMPW{lsrc=operand lsrc, rsrc=operand rsrc}
425                      | I.CMPB{lsrc, rsrc} => I.CMPB{lsrc=operand lsrc, rsrc=operand rsrc}
426                      | I.TESTL{lsrc, rsrc} => I.TESTL{lsrc=operand lsrc, rsrc=operand rsrc}
427                      | I.TESTW{lsrc, rsrc} => I.TESTW{lsrc=operand lsrc, rsrc=operand rsrc}
428                      | I.TESTB{lsrc, rsrc} => I.TESTB{lsrc=operand lsrc, rsrc=operand rsrc}
429                      | I.BITOP{bitOp, lsrc, rsrc} =>
430                        I.BITOP{bitOp=bitOp, lsrc=operand lsrc, rsrc=operand rsrc}
431                      | I.BINARY{binOp, src, dst} =>
432                        I.BINARY{binOp=binOp, src=operand src, dst=operand dst}
433                      | I.SHIFT{shiftOp, src, dst, count} =>
434                        I.SHIFT{shiftOp=shiftOp, src=operand src, dst=operand dst,
435                                count=operand src}
436                    (* end case *))
437    
438                 fun f(I.ANNOTATION{a,i}) =
439                     I.ANNOTATION{i=rewriteUse(i, rs, rt),
440                                  a = case a of
441                                          CB.DEF_USE{cellkind=CB.GP,defs,uses} =>
442                                          CB.DEF_USE{cellkind=CB.GP,uses=map replace uses,
443                                                     defs=defs}
444                                        | _ => a}
445                   | f(I.INSTR i) = I.INSTR(rewrite(i))
446                   | f(I.COPY{k as CB.GP, sz, dst, src, tmp}) =
447                     I.COPY{k=k, sz=sz, dst=dst, src=List.map replace src, tmp=tmp}
448             in
449                 f (instr:I.instruction)
450             end
451    
452    
453           fun frewriteDef _ = raise Fail ""           fun frewriteDef _ = raise Fail ""
454           fun frewriteUse _ = raise Fail ""           fun frewriteUse _ = raise Fail ""
455         end         end
# Line 263  Line 463 
463    
464       datatype spillOperandKind = SPILL_LOC | CONST_VAL       datatype spillOperandKind = SPILL_LOC | CONST_VAL
465       type spill_info = unit       type spill_info = unit
466       fun beforeRA _ = raise Fail ""       fun beforeRA _ = ()
467    
468       val architecture = "amd64"       val architecture = "amd64"
469       fun pure _ = true       fun pure _ = true
470    
471       structure Int =       structure Int =
472          struct          struct
473            val avail = []            val avail = C.Regs CellsBasis.GP {from=0, to=15, step=1}
474            val dedicated = []            val dedicated = [C.rsp, C.rbp]
475            fun spillLoc _ = raise Fail ""            fun spillLoc _ = raise Fail ""
476            val mode = RACore.NO_OPTIMIZATION            val mode = RACore.NO_OPTIMIZATION
477          end          end
478       structure Float =       structure Float =
479          struct          struct
480            val avail = []            val avail = C.Regs CellsBasis.FP {from=0, to=15, step=1}
481            val dedicated = []            val dedicated = []
482            fun spillLoc _ = raise Fail ""            fun spillLoc _ = raise Fail ""
483            val mode = RACore.NO_OPTIMIZATION            val mode = Word.orb (RACore.HAS_PARALLEL_COPIES, RACore.DEAD_COPY_ELIM)
484          end          end
485    
486      )      )
487    
488    structure RA = RA2
489    structure Cells = AMD64Instr.C
490    structure T = AMD64MLTree
491    structure CFG = AMD64CFG
492    structure FlowGraph = AMD64FlowGraph
493    
494    structure TestStagedAllocation =
495      struct
496    
497        val wordTy = 64
498    
499        fun codegen (functionName, target, proto, initStms, args) = let
500            val _ = Label.reset()
501    
502            val [functionName, target] = List.map Label.global [functionName, target]
503    
504            val insnStrm = FlowGraph.build()
505            (* construct the C call *)
506            val {result, callseq} = CCalls.genCall {
507                       name=T.LABEL target,
508                       paramAlloc=fn _ => false,
509                       structRet=fn _ => T.REG (64, Cells.rax),
510                       saveRestoreDedicated=fn _ => {save=[], restore=[]},
511                       callComment=NONE,
512                       proto=proto,
513                       args=args}
514    
515            fun wordLit i = T.LI (T.I.fromInt (wordTy, i))
516    
517            val stms = List.concat [
518                       [T.EXT(AMD64InstrExt.PUSHQ(T.REG(64, Cells.rbp))),
519                        T.COPY (wordTy, [Cells.rbp], [Cells.rsp])],
520                       initStms,
521                       callseq,
522                       [T.EXT(AMD64InstrExt.LEAVE)],
523                       [T.RET []]]
524    
525            val stream as AMD64Stream.STREAM
526               { beginCluster,  (* start a cluster *)
527                 endCluster,    (* end a cluster *)
528                 emit,          (* emit MLTREE stm *)
529                 defineLabel,   (* define a local label *)
530                 entryLabel,    (* define an external entry *)
531                 exitBlock,     (* mark the end of a procedure *)
532                 pseudoOp,      (* emit a pseudo op *)
533                 annotation,    (* add an annotation *)
534                 ... } =
535                 AMD64.selectInstructions insnStrm
536            fun doit () = (
537                beginCluster 0;      (* start a new cluster *)
538                pseudoOp PseudoOpsBasisTyp.TEXT;
539                pseudoOp (PseudoOpsBasisTyp.EXPORT [functionName]);
540                entryLabel functionName; (* define the entry label *)
541                List.app emit stms; (* emit all the statements *)
542                exitBlock result;
543                endCluster [])
544            val cfg = doit ()
545            val cfg = RA.run cfg
546            val cfg = AMD64Expand.run cfg
547            in
548             (cfg, stream)        (* end the cluster *)
549           end (* codegen *)
550    
551        fun dumpOutput (cfg, stream) = let
552            val (cfg as Graph.GRAPH graph, blocks) =
553                    AMD64BlockPlacement.blockPlacement cfg
554            val CFG.INFO{annotations=an, data, decls, ...} = #graph_info graph
555            in
556              AMD64Emit.asmEmit (cfg, blocks)
557            end (* dumpOutput *)
558    
559      end
560    
561    
562        (* machine-specific data *)
563        val wordTy = 64
564        val wordSzB = wordTy div 8
565        val param0 = T.REG(wordTy, Cells.rdi)
566    
567        (* maximum argument size in machine words *)
568        val maxArgSz = 16
569        val maxArgSzB = maxArgSz * wordSzB

Legend:
Removed from v.3000  
changed lines
  Added in v.3037

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0