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

SCM Repository

[smlnj] Annotation of /sml/trunk/src/MLRISC/flowgraph/darwin-pseudo-ops.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/flowgraph/darwin-pseudo-ops.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1921 - (view) (download)

1 : jhr 1921 (* darwin-pseudo-ops.sml
2 :     *
3 :     * COPYRIGHT (c) 2006 The Fellowship of SML/NJ (www.smlnj.org)
4 :     * All rights reserved.
5 :     *
6 :     * Implements the string related functions to emit pseudo-ops
7 :     * in the Darwin (Mac OS X) assembler syntax.
8 :     *)
9 :    
10 :     functor DarwinPseudoOps (
11 :     structure T : MLTREE
12 :     val labFmt : {gPrefix: string, aPrefix: string}
13 :     ) : AS_PSEUDO_OPS =
14 :     struct
15 :     structure T = T
16 :     structure PB = PseudoOpsBasisTyp
17 :     structure Fmt = Format
18 :    
19 :     fun error msg = MLRiscErrorMsg.error ("DarwinPseudoOps.", msg)
20 :    
21 :     fun prIntInf i =
22 :     if IntInf.sign i < 0
23 :     then "-"^IntInf.toString(IntInf.~ i)
24 :     else IntInf.toString i
25 :    
26 :     fun prInt i = if i < 0 then "-"^Int.toString(~i) else Int.toString i
27 :    
28 :     (* operator precedences follow C (which is different from gas!):
29 :     *
30 :     * 4 NEG, NOTB (unary)
31 :     * 3 MULS, DIVS
32 :     * 2 PLUS, MINUS
33 :     * 1 ANDB, ORB, XORB
34 :     * 0 LSHIFT, RSHIFT
35 :     *)
36 :    
37 :     (* NOTE: we use ">=" here instead of ">" so that we don't have to worry about associativity *)
38 :     fun parens (str, prec, op_prec) =
39 :     if prec >= op_prec then concat["(", str, ")"] else str
40 :     fun parensBop (s1, s2, s3, prec, op_prec) =
41 :     if prec >= op_prec
42 :     then concat["(", s1, s2, s3, ")"]
43 :     else concat[s1, s2, s3]
44 :    
45 :     fun lexpToString le = toStr(le, 0)
46 :    
47 :     and toStr(T.LABEL lab, _) = Label.fmt labFmt lab
48 :     | toStr(T.LABEXP le, p) = toStr(le, p)
49 :     | toStr(T.NEG(_, T.CONST c), _) =
50 :     (prInt(~(T.Constant.valueOf c)) handle _ => "-"^T.Constant.toString c)
51 :     | toStr(T.NEG(_, T.LI i), _) = prIntInf(~i)
52 :     | toStr(T.NEG(_, lexp), prec) = "-" ^ parens(toStr(lexp, 4), prec, 4)
53 :     | toStr(T.NOTB(_, lexp), prec) = "~" ^ parens(toStr(lexp, 4), prec, 4)
54 :     | toStr(T.CONST c, _) =
55 :     (prInt(T.Constant.valueOf c) handle _ => T.Constant.toString c)
56 :     | toStr(T.LI i, _) = prIntInf i
57 :     | toStr(T.MULS(_, lexp1, lexp2), prec) =
58 :     parensBop(toStr(lexp1, 3), "*", toStr(lexp2, 3), prec, 3)
59 :     | toStr(T.DIVS(T.DIV_TO_ZERO, _, lexp1, lexp2), prec) =
60 :     parensBop(toStr(lexp1, 3), "/", toStr(lexp2, 3), prec, 3)
61 :     | toStr(T.ADD(_, lexp1, lexp2), prec) =
62 :     parensBop(toStr(lexp1, 2), "+", toStr(lexp2, 2), prec, 2)
63 :     | toStr(T.SUB(_, lexp1, lexp2), prec) =
64 :     parensBop(toStr(lexp1, 2), "-", toStr(lexp2, 2), prec, 2)
65 :     | toStr(T.ANDB(_, lexp, mask), prec) =
66 :     parensBop(toStr(lexp, 1), "&", toStr(mask, 1), prec, 1)
67 :     | toStr(T.ORB(_, lexp, mask), prec) =
68 :     parensBop(toStr(lexp, 1), "|", toStr(mask, 1), prec, 1)
69 :     | toStr(T.XORB(_, lexp, mask), prec) =
70 :     parensBop(toStr(lexp, 1), "^", toStr(mask, 1), prec, 1)
71 :     | toStr(T.SLL(_, lexp, cnt), prec) =
72 :     parensBop(toStr(lexp, 0), "<<", toStr(cnt, 0), prec, 0)
73 :     | toStr(T.SRA(_, lexp, cnt), prec) =
74 :     parensBop(toStr(lexp, 0), ">>", toStr(cnt, 0), prec, 0)
75 :     | toStr _ = error "toStr"
76 :    
77 :     fun defineLabel lab = lexpToString (T.LABEL lab) ^ ":"
78 :    
79 :     fun decls (fmt, labs) =
80 :     String.concat
81 :     (map (fn lab => (Fmt.format fmt [Fmt.STR (lexpToString(T.LABEL lab))])) labs)
82 :    
83 :     fun toString(PB.ALIGN_SZ n) = Fmt.format "\t.align\t%d" [Fmt.INT n]
84 :     | toString(PB.ALIGN_ENTRY) = "\t.align\t4" (* 16 byte boundary *)
85 :     | toString(PB.ALIGN_LABEL) = "\t.p2align\t4,,7"
86 :    
87 :     | toString(PB.DATA_LABEL lab) = Label.fmt labFmt lab ^ ":"
88 :     | toString(PB.DATA_READ_ONLY) = "\t.const_data"
89 :     | toString(PB.DATA) = "\t.data"
90 :     | toString(PB.BSS) = raise Fail "BSS not supported; use DATA instead"
91 :     | toString(PB.TEXT) = "\t.text"
92 :     | toString(PB.SECTION at) = "\t.section\t" ^ Atom.toString at
93 :    
94 :     | toString(PB.REORDER) = ""
95 :     | toString(PB.NOREORDER) = ""
96 :    
97 :     | toString(PB.INT{sz, i}) = let
98 :     fun join [] = []
99 :     | join [lexp] = [lexpToString lexp]
100 :     | join (lexp::r) = lexpToString lexp :: "," :: join r
101 :     val pop = (case sz
102 :     of 8 => "\t.byte\t"
103 :     | 16 => "\t.short\t"
104 :     | 32 => "\t.long\t" (* NOTE: ".int" doesn't work on Mac OS X! *)
105 :     | 64 => "\t.quad\t"
106 :     | n => error ("unexpected INT size: " ^ Int.toString n)
107 :     (* end case *))
108 :     in
109 :     String.concat (pop :: join i)
110 :     end
111 :    
112 :     | toString(PB.ASCII s) =
113 :     Fmt.format "\t.ascii\t\"%s\"" [Fmt.STR(String.toCString s)]
114 :     | toString(PB.ASCIIZ s) =
115 :     Fmt.format "\t.asciz \"%s\"" [Fmt.STR(String.toCString s)]
116 :    
117 :     | toString(PB.SPACE sz) = Fmt.format "\t.space\t%d" [Fmt.INT sz]
118 :    
119 :     | toString(PB.FLOAT{sz, f}) = let
120 :     fun join [] = []
121 :     | join [f] = [f]
122 :     | join (f::r) = f :: "," :: join r
123 :     val pop = (case sz
124 :     of 32 => "\t.single "
125 :     | 64 => "\t.double "
126 :     | n => error ("unexpected FLOAT size: " ^ Int.toString n)
127 :     (* end case *))
128 :     in
129 :     String.concat (pop :: join f)
130 :     end
131 :    
132 :     | toString(PB.IMPORT labs) = decls("\t.extern\t%s", labs)
133 :     | toString(PB.EXPORT labs) = decls("\t.globl\t%s", labs)
134 :     | toString(PB.COMMENT txt) = Fmt.format "/* %s */" [Fmt.STR txt]
135 :    
136 :    
137 :     | toString(PB.EXT _) = error "EXT"
138 :    
139 :     end

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