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/gasPseudoOps.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/flowgraph/gasPseudoOps.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1181 - (view) (download)

1 : george 991 (* gasPseudoOps.sml
2 :     *
3 :     * COPYRIGHT (c) 2001 Lucent Technologies, Bell Laboratories.
4 :     *
5 :     * Implements the string related functions to emit pseudo-ops
6 :     * in the standard GAS syntax.
7 :     *)
8 : george 984 signature GAS_PSEUDO_OPS = sig
9 :     structure T : MLTREE
10 :     val lexpToString : T.labexp -> string
11 :     val toString : (T.labexp, 'a) PseudoOpsBasisTyp.pseudo_op -> string
12 :     val defineLabel : Label.label -> string
13 :     end
14 :    
15 :     functor GasPseudoOps
16 :     ( structure T : MLTREE
17 :     val labFmt : {gPrefix: string, aPrefix: string}
18 :     ) : GAS_PSEUDO_OPS =
19 :     struct
20 :     structure T = T
21 :     structure PB = PseudoOpsBasisTyp
22 :     structure Fmt = Format
23 :    
24 :     fun error msg = MLRiscErrorMsg.error ("GasPseudoOps.", msg)
25 :    
26 :     fun prIntInf i = if IntInf.sign i < 0 then "-"^IntInf.toString(IntInf.~ i)
27 :     else IntInf.toString i
28 :    
29 :     fun prInt i = if i < 0 then "-"^Int.toString(~i) else Int.toString i
30 :    
31 :     (* operator precedences:
32 :     Note: these differ from C's precedences
33 :     2 MULT, DIV, LSHIFT, RSHIFT
34 :     1 AND, OR
35 :     0 PLUS, MINUS
36 :     *)
37 :    
38 :     fun parens (str, prec, op_prec) =
39 :     if prec > op_prec then "(" ^ str ^ ")" else str
40 :    
41 :     fun lexpToString le = toStr(le, 0)
42 :    
43 :     and toStr(T.LABEL lab, _) = Label.fmt labFmt lab
44 :     | toStr(T.LABEXP le, p) = toStr(le, p)
45 :     | toStr(T.CONST c, _) =
46 :     (prInt(T.Constant.valueOf c) handle _ => T.Constant.toString c)
47 :     | toStr(T.LI i, _) = prIntInf i
48 :     | toStr(T.MULS(_,lexp1, lexp2), _) = toStr(lexp1, 2) ^ "*" ^ toStr(lexp2,2)
49 : blume 1181 | toStr(T.DIVS(T.DIV_TO_ZERO,_,lexp1, lexp2), _) =
50 :     toStr(lexp1, 2) ^ "/" ^ toStr(lexp2,2) (* what if DIV_TO_NEGINF ?? *)
51 : george 984 | toStr(T.SLL(_,lexp, cnt), prec) = toStr(lexp,2) ^ "<<" ^ toStr(cnt,2)
52 :     | toStr(T.SRL(_,lexp, cnt), prec) = toStr(lexp,2) ^ ">>" ^ toStr(cnt,2)
53 :     | toStr(T.ANDB(_,lexp, mask), prec) =
54 :     parens(toStr(lexp,1) ^ "&" ^ toStr(mask, 1), prec, 1)
55 :     | toStr(T.ORB(_,lexp, mask), prec) =
56 :     parens(toStr(lexp, 1) ^ "|" ^ toStr(mask, 1), prec, 1)
57 :     | toStr(T.ADD(_,lexp1, lexp2), prec) =
58 :     parens(toStr(lexp1, 0) ^ "+" ^ toStr(lexp2, 0), prec, 0)
59 :     | toStr(T.SUB(_,lexp1, lexp2), prec) =
60 :     parens(toStr(lexp1, 0) ^ "-" ^ toStr(lexp2, 0), prec, 0)
61 :     | toStr _ = error "toStr"
62 :    
63 :     fun defineLabel lab = lexpToString (T.LABEL lab) ^ ":"
64 :    
65 :     fun decls (fmt, labs) =
66 :     String.concat
67 :     (map (fn lab => (Fmt.format fmt [Fmt.STR (lexpToString(T.LABEL lab))])) labs)
68 :    
69 : jhr 1023 fun toString(PB.ALIGN_SZ n) = Fmt.format "\t.align\t%d" [Fmt.INT n]
70 :     | toString(PB.ALIGN_ENTRY) = "\t.align\t4" (* 16 byte boundary *)
71 :     | toString(PB.ALIGN_LABEL) = "\t.p2align\t4,,7"
72 : george 984
73 :     | toString(PB.DATA_LABEL lab) = Label.fmt labFmt lab ^ ":"
74 : jhr 1023 | toString(PB.DATA_READ_ONLY) = "\t.section\t.rodata"
75 :     | toString(PB.DATA) = "\t.data"
76 :     | toString(PB.BSS) = "\t.section\t.bss"
77 :     | toString(PB.TEXT) = "\t.text"
78 :     | toString(PB.SECTION at) = "\t.section\t" ^ Atom.toString at
79 : george 984
80 :     | toString(PB.REORDER) = ""
81 :     | toString(PB.NOREORDER) = ""
82 :    
83 : jhr 1023 | toString(PB.INT{sz, i}) = let
84 :     fun join [] = []
85 :     | join [lexp] = [lexpToString lexp]
86 :     | join (lexp::r) = lexpToString lexp :: "," :: join r
87 :     val pop = (case sz
88 :     of 8 => "\t.byte\t"
89 :     | 16 => "\t.short\t"
90 :     | 32 => "\t.int\t"
91 :     | 64 => error "INT64"
92 :     (* end case *))
93 :     in
94 :     String.concat (pop :: join i)
95 :     end
96 : george 984
97 : jhr 1023 | toString(PB.ASCII s) =
98 :     Fmt.format "\t.ascii\t\"%s\"" [Fmt.STR(String.toCString s)]
99 : george 1018 | toString(PB.ASCIIZ s) =
100 : jhr 1026 Fmt.format "\t.asciz \"%s\"" [Fmt.STR(String.toCString s)]
101 : george 984
102 : jhr 1023 | toString(PB.SPACE sz) = Fmt.format "\t.space\t%d" [Fmt.INT sz]
103 : george 1012
104 : jhr 1023 | toString(PB.FLOAT{sz, f}) = let
105 :     fun join [] = []
106 :     | join [f] = [f]
107 :     | join (f::r) = f :: "," :: join r
108 :     val pop = (case sz
109 :     of 32 => "\t.single "
110 :     | 64 => "\t.double "
111 :     | 128 => "\t.extended "
112 :     (* end case *))
113 :     in
114 :     String.concat (pop :: join f)
115 :     end
116 : george 984
117 : jhr 1023 | toString(PB.IMPORT labs) = decls("\t.extern\t%s", labs)
118 :     | toString(PB.EXPORT labs) = decls("\t.global\t%s", labs)
119 : jhr 1022 | toString(PB.COMMENT txt) = Fmt.format "/* %s */" [Fmt.STR txt]
120 : george 1020
121 : george 984
122 :     | toString(PB.EXT _) = error "EXT"
123 :    
124 : jhr 1022 end

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