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

Parent Directory | Revision Log

---

Revision 1012 - (view) (download)

1 :	george	991	(* pseudo-ops-little.sml
2 :			*
3 :			* COPYRIGHT (c) 2001 Lucent Technologies, Bell Laboratories.
4 :			*
5 :			* Subset of pseudo-ops functions that are little endian sensitive
6 :	george	984	*)
7 :	george	991
8 :	george	984	functor PseudoOpsLittle
9 :			( structure T : MLTREE
10 :			structure MLTreeEval : MLTREE_EVAL
11 :			where T = T
12 :			val icache_alignment : int (* cache line size *)
13 :			val max_alignment : int option (* maximum alignment for internal labels *)
14 :			val nop: {sz:int, en:Word32.word} (* encoding for noop *)
15 :	george	991	) : PSEUDO_OPS_ENDIAN =
16 :	george	984	struct
17 :			structure W = Word
18 :			structure T = T
19 :			structure PB = PseudoOpsBasisTyp
20 :	george	991	type 'a pseudo_op = (T.labexp, 'a) PB.pseudo_op
21 :	george	984
22 :			fun error msg = MLRiscErrorMsg.error ("PseudoOpsLittle.", msg)
23 :
24 :			val >> = Word.>>
25 :			val ~>> = Word.~>>
26 :			val & = Word.andb
27 :			infix >> ~>> &
28 :
29 :			(* return loc aligned at bndry *)
30 :			fun align(loc, bndry) = let
31 :			val mask = W.fromInt bndry - 0w1
32 :			in W.toIntX(W.andb(W.fromInt loc + mask, W.notb mask))
33 :			end
34 :
35 :			(* bytes of padding required *)
36 :			fun padding(loc, bndry) = align(loc, bndry) - loc
37 :
38 :			fun pow2(x, 0) = x
39 :			| pow2(x, n) = pow2(x * 2, n-1)
40 :
41 :			fun bytesIn sz = Int.quot(sz, 8)
42 :
43 :			fun sizeOf(pOp, loc) =
44 :			(case pOp
45 :			of PB.ALIGN_SZ n => padding(loc, pow2(1, n))
46 :			| PB.ALIGN_ENTRY => padding(loc, icache_alignment)
47 :			| PB.ALIGN_LABEL => let
48 :			val pad = padding(loc, icache_alignment)
49 :			in
50 :			case max_alignment
51 :			of NONE => pad
52 :			| SOME m => if pad <= m then pad else 0
53 :			end
54 :
55 :			| PB.INT{sz, i} => length(i) * bytesIn sz
56 :
57 :			| PB.ASCII s => String.size s
58 :			| PB.ASCIIZ s => String.size s + 1
59 :
60 :	george	1012	| PB.SPACE(sz) => sz
61 :
62 :	george	984	| PB.FLOAT{sz, f} => length(f) * bytesIn sz
63 :
64 :			| PB.EXT _ => error "sizeOf: EXT"
65 :			| _ => 0
66 :			(*esac*))
67 :
68 :
69 :			fun emitValue{pOp, loc, emit} = let
70 :			val itow = W.fromInt
71 :			fun emitByte n = emit(Word8.fromLargeWord(W.toLargeWord n))
72 :			fun emitWord n = (emitByte(n & 0w255); emitByte((n >> 0w8) & 0w255))
73 :
74 :			fun emitLongX n = let
75 :			val w = itow n
76 :			in emitWord(w & 0w65535); emitWord(w ~>> 0w16)
77 :			end
78 :
79 :			local
80 :			val {sz, en} = nop
81 :			val toWord = W.fromLargeInt o Word32.toLargeIntX
82 :			in
83 :			fun emitNop () =
84 :			case sz
85 :			of 1 => emitByte (toWord en)
86 :			| 2 => emitWord (toWord en)
87 :			| 4 => (emitWord(toWord(Word32.andb(en, 0w65535)));
88 :			emitWord(toWord(Word32.>>(en, 0w16))))
89 :
90 :			fun insertNops 0 = ()
91 :			| insertNops n =
92 :			if n >= sz then (emitNop(); insertNops(n-sz))
93 :			else error "insertNops"
94 :			end
95 :
96 :			fun align(loc, bndry) = let
97 :			val bndry = Word.fromInt bndry
98 :			val mask = bndry - 0w1
99 :			in
100 :			case W.andb(itow(loc), mask)
101 :			of 0w0 => ()
102 :			| w => let
103 :			val padSz = (bndry - w)
104 :			in insertNops(Word.toInt padSz)
105 :			end
106 :			(*esac*)
107 :			end
108 :
109 :			val {ccexp, rexp} =
110 :			MLTreeEval.eval
111 :			{const = IntInf.fromInt o T.Constant.valueOf,
112 :			label = Label.addrOf}
113 :			in
114 :			case pOp
115 :			of PB.ALIGN_SZ n => insertNops(sizeOf(pOp, loc))
116 :			| PB.ALIGN_ENTRY => insertNops(sizeOf(pOp, loc))
117 :			| PB.ALIGN_LABEL => insertNops(sizeOf(pOp, loc))
118 :
119 :			| PB.INT{sz, i} => let
120 :			val ints = map (IntInf.toInt o rexp) i
121 :			in
122 :			case sz
123 :			of 8 => app (emitByte o itow) ints
124 :			| 16 => app (emitWord o itow) ints
125 :			| 32 => app emitLongX ints
126 :			| _ => error "emitValue: INT 64"
127 :			(*esac*)
128 :			end
129 :
130 :			| PB.ASCII s => app (emit o Word8.fromInt o Char.ord) (String.explode s)
131 :			| PB.ASCIIZ s => (emitValue{pOp=PB.ASCII s, loc=loc, emit=emit}; emit 0w0)
132 :
133 :			| PB.FLOAT{sz, f} => error "emitValue: FLOAT - not implemented"
134 :			| PB.EXT _ => error "emitValue: EXT"
135 :	george	1012	| PB.SPACE _ => error "emitValue: SPACE"
136 :	george	984	| _ => ()
137 :			end
138 :			end

---

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