![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to mipscoder.sml CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / sml / src / mips|
Return to mipscoder.sml CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / mips |
1.1 root 1: (* Copyright 1989 by AT&T Bell Laboratories *)
2: structure MipsCoder : MIPSCODER = struct
3:
4: type Label = int ref
5:
6: datatype Register = Reg of int
7:
8: datatype EA = Direct of Register
9: | Immed of int
10: | Immedlab of Label
11:
12: datatype size = Byte | Word | Floating
13: datatype muldiv = MULT | DIV
14:
15: datatype instr =
16: STRINGCONST of string (* constants *)
17: | REALCONST of string
18: | EMITLONG of int
19:
20: | DEFINE of Label (* labels *)
21: | EMITLAB of int * Label
22:
23: | SLT of Register * EA * Register (* control flow *)
24: | BEQ of bool * Register * Register * Label
25: | JUMP of Register
26: | SLT_D of Register * Register
27: | SEQ_D of Register * Register
28: | BCOP1 of bool * Label
29:
30: | NOP (* no-op for delay slot *)
31:
32: | ADD of Register * EA * Register (* arithmetic *)
33: | AND of Register * EA * Register
34: | OR of Register * EA * Register
35: | XOR of Register * EA * Register
36: | SUB of Register * Register * Register
37: | MULDIV of muldiv * Register * Register
38: | MFLO of Register (* mflo instruction used with
39: 64-bit multiply and divide *)
40: | MFHI of Register
41:
42: | NEG_D of Register * Register
43: | MUL_D of Register * Register * Register
44: | DIV_D of Register * Register * Register
45: | ADD_D of Register * Register * Register
46: | SUB_D of Register * Register * Register
47:
48: | MOVE of EA * Register (* put something into a register *)
49: | LDI_32 of int * Register (* load in a big immediate constant (>16 bits) *)
50: | LUI of Register * int (* Mips lui instruction *)
51:
52: | LOAD of size * Register * EA * int (* load and store *)
53: | STORE of size * Register * EA * int
54:
55: | SLL of EA * Register * Register (* shift *)
56: | SRA of EA * Register * Register
57:
58: | COMMENT of string (* generates nothing *)
59: | MARK (* a backpointer *)
60:
61: val kept = ref nil : instr list ref
62: fun keep f a = kept := f a :: !kept
63: fun delay f a = kept := NOP :: f a :: !kept
64: fun keeplist l = kept := l @ !kept
65:
66: structure M = struct
67: val emitstring = keep STRINGCONST (* literals *)
68: val realconst = keep REALCONST
69: val emitlong = keep EMITLONG
70:
71: fun newlabel () = ref 0
72: val define = keep DEFINE
73: val emitlab = keep EMITLAB (* labels *)
74:
75: val slt = keep SLT (* control flow *)
76: val beq = delay BEQ
77: val jump = delay JUMP
78: val slt_double = delay SLT_D
79: val seq_double = delay SEQ_D
80: val bcop1 = delay BCOP1
81:
82: val add = keep ADD (* arithmetic *)
83: val and' = keep AND
84: val or = keep OR
85: val xor = keep XOR
86: val op sub = keep SUB
87: fun muldiv f (a,b,c) = keeplist [MFLO c, MULDIV (f,a,b)]
88: val op div = muldiv DIV
89: val mult = muldiv MULT
90: val mfhi = keep MFHI
91:
92: val neg_double = keep NEG_D
93: val mul_double = keep MUL_D
94: val div_double = keep DIV_D
95: val add_double = keep ADD_D
96: val sub_double = keep SUB_D
97:
98: val move = keep MOVE
99:
100: fun lbu (a,b,c) = delay LOAD (Byte,a,b,c) (* load and store *)
101: fun lw (a,b,c) = delay LOAD (Word,a,b,c)
102: fun lwc1 (a,b,c) = delay LOAD (Floating,a,b,c)
103: fun sb (a,b,c) = keep STORE (Byte,a,b,c)
104: fun sw (a,b,c) = keep STORE (Word,a,b,c)
105: fun swc1 (a,b,c) = delay STORE (Floating,a,b,c)
106: val lui = keep LUI
107:
108: val sll = keep SLL (* shift *)
109: val sra = keep SRA
110:
111: fun align() = () (* never need to align on MIPS *)
112: val mark = keep (fn () => MARK)
113: val comment = keep COMMENT
114: end
115:
116: open M
117:
118: fun get (SOME x) = x
119: | get NONE = ErrorMsg.impossible "missing pcptr in mipscoder"
120:
121: fun needs_a_pcptr(_,SLT(_,Immedlab _,_)) = true
122: | needs_a_pcptr(_,ADD(_,Immedlab _,_)) = true
123: | needs_a_pcptr(_,AND(_,Immedlab _,_)) = true
124: | needs_a_pcptr(_,OR(_,Immedlab _,_)) = true
125: | needs_a_pcptr(_,XOR(_,Immedlab _,_)) = true
126: | needs_a_pcptr(_,MOVE(Immedlab _,_)) = true
127: | needs_a_pcptr(_,LOAD(_,_,Immedlab _,_)) = true
128: | needs_a_pcptr(_,STORE(_,_,Immedlab _,_)) = true
129: | needs_a_pcptr(_,SLL(Immedlab _,_,_)) = true
130: | needs_a_pcptr(_,SRA(Immedlab _,_,_)) = true
131: | needs_a_pcptr(1, BEQ _) = false (* small BEQ's dont need pcptr *)
132: | needs_a_pcptr(_, BEQ _) = true (* but large ones do *)
133: | needs_a_pcptr(1, BCOP1 _) = false (* small BCOP1's dont need pcptr *)
134: | needs_a_pcptr(_, BCOP1 _) = true (* but large ones do *)
135: | needs_a_pcptr _ = false
136: fun pass emitters =
137: let fun makepcptr(i,x) =
138: (* may need to emit NOP for delay slot if next instr is branch *)
139: let val size = case x of ((_,BEQ _)::rest) => 2
140: | ((_,BCOP1 _)::rest) => 2
141: | _ => 1
142: in case emitters of NONE => ()
143: | SOME (emit, _, _ ) => (
144: emit(Opcodes.bltzal(0,0));
145: if size=2 then emit(Opcodes.add(0,0,0)) else ());
146: gen(i+size, SOME (i+2), x)
147: end
148: and gen(i,_,nil) = i
149: | gen(i, _, (_,DEFINE lab) :: rest) = (lab := i; gen(i,NONE, rest))
150: (* invalidate the pc pointer at labels *)
151: (* may want to do special fiddling with NOPs *)
152: | gen(pos, pcptr, x as ((sizeref as ref size, inst) :: rest)) =
153: if (pcptr=NONE andalso needs_a_pcptr(size, inst)) then makepcptr(pos,x)
154: else case emitters of
155: SOME (emit : int*int -> unit, emit_string : int -> string -> unit,
156: emit_real : string -> unit) =>
157: let fun gen1() = gen(pos+size,pcptr,rest)
158: (* generate the rest of the [[instr]]s *)
159: open Bits
160: open Opcodes
161: val tempreg = 1
162: val pcreg = 31
163: fun emitlong i = emit(rshift(i,16), andb(i,65535))
164: (* emit one long word (no sign fiddling) *)
165: fun split i = let val hi = rshift(i,16) and lo = andb(i,65535)
166: in if lo<32768 then (hi,lo) else (hi+1, lo-65536)
167: end
168:
169: fun arith (opr, rform, iform) =
170: let fun ar (Reg op1, Direct (Reg op2), Reg result) =
171: gen1(emit(rform(result,op1,op2)))
172: | ar (Reg op1, Immed op2, Reg result) =
173: (case size of
174: 1 (* 16 bits *) => gen1(emit(iform(result,op1,op2)))
175: | 3 (* 32 bits *) =>
176: gen(pos,pcptr,
177: (ref 2, LDI_32(op2, Reg tempreg))::
178: (ref 1, opr(Reg op1, Direct(Reg tempreg), Reg result))::
179: rest)
180: | _ => gen(ErrorMsg.impossible
181: "bad size in arith Immed in mipscoder")
182: )
183: | ar (Reg op1, Immedlab (ref op2), Reg result) =
184: gen(pos, pcptr,
185: (ref (size-1),
186: ADD(Reg pcreg,Immed(4*(op2-(get pcptr))), Reg tempreg))::
187: (ref 1, opr(Reg op1, Direct(Reg tempreg), Reg result))::
188: rest)
189: in ar
190: end
191: fun float3double instruction (Reg op1,Reg op2,Reg result) =
192: gen1(emit(instruction(D_fmt,result,op1,op2)))
193: fun domove (Direct (Reg src), Reg dest) = gen1(emit(add(dest,src,0)))
194: | domove (Immed src, Reg dest) =
195: (case size of
196: 1 (* 16 bits *) => gen1(emit(addi(dest,0,src)))
197: | 2 (* 32 bits *) =>
198: gen(pos,pcptr,(ref 2, LDI_32(src, Reg dest))::rest)
199: | _ => gen(ErrorMsg.impossible "bad size in domove Immed in mipscoder")
200: )
201: | domove (Immedlab (ref src), Reg dest) =
202: gen(pos, pcptr,
203: (ref size,
204: ADD(Reg pcreg,Immed(4*(src-(get pcptr))), Reg dest))::rest)
205: fun memop(rform,Reg dest, Direct (Reg base), offset) =
206: (case size
207: of 1 => gen1(emit(rform(dest,offset,base)))
208: | 3 => let val (hi,lo) = split offset
209: in gen1(emit(lui(tempreg,hi)); (* tempreg = hi << 16 *)
210: emit(add(tempreg,base,tempreg));(* tempreg += base *)
211: emit(rform(dest,lo,tempreg)) (* load dest,lo(tempreg) *)
212: )
213: end
214: | _ => gen1(ErrorMsg.impossible "bad size in memop Direct in mipscoder")
215: )
216: | memop(rform,Reg dest, Immed address, offset) =
217: (case size
218: of 1 => gen1(emit(rform(dest,offset+address,0)))
219: | 2 => let val (hi,lo) = split (offset+address)
220: in gen1(emit(lui(tempreg,hi));
221: emit(rform(dest,lo,tempreg))
222: )
223: end
224: | _ => gen1(ErrorMsg.impossible "bad size in memop Immed in mipscoder")
225: )
226: | memop(rform,Reg dest, Immedlab (ref lab), offset) =
227: memop(rform, Reg dest, Direct (Reg pcreg), offset+4*(lab - get pcptr))
228: in case inst of
229: STRINGCONST s =>
230: let val s' = s ^ "\000\000\000\000"
231: in gen1(emit_string (4*size) s')
232: (* doesn't know Big vs Little-Endian *)
233: end
234: | REALCONST s => gen1(emit_real s) (* floating pt constant *)
235: | EMITLONG i => gen1(emitlong i)
236: | DEFINE _ => gen1(ErrorMsg.impossible "generate code for DEFINE in mipscoder")
237: | EMITLAB(i, ref d) => gen1(emitlong((d-pos)*4+i))
238: | ADD stuff => arith (ADD,add,addi) stuff
239: | AND stuff => arith (AND,and',andi) stuff
240: | OR stuff => arith (OR,or,ori) stuff
241: | XOR stuff => arith (XOR,xor,xori) stuff
242: | SUB (Reg op1, Reg op2, Reg result) => gen1(emit(sub(result,op1,op2)))
243: | MULDIV(DIV, Reg op1, Reg op2) => gen1(emit(div(op1,op2)))
244: | MULDIV(MULT,Reg op1, Reg op2) => gen1(emit(mult(op1,op2)))
245: | MFLO(Reg result) => gen1(emit(mflo(result)))
246: | MFHI(Reg result) => gen1(emit(mfhi(result)))
247: | NEG_D (Reg op1,Reg result) => gen1(emit(neg_fmt(D_fmt,result,op1)))
248: | MUL_D x => float3double mul_fmt x
249: | DIV_D x => float3double div_fmt x
250: | ADD_D x => float3double add_fmt x
251: | SUB_D x => float3double sub_fmt x
252:
253:
254: | MOVE stuff => domove stuff
255: | LDI_32 (immedconst, Reg dest) =>
256: let val (hi,lo) = split immedconst
257: in gen1(emit(lui(dest,hi));emit(addi(dest,dest,lo)))
258: end
259: | LUI (Reg dest,immed16) => gen1(emit(lui(dest,immed16)))
260:
261: | SLT stuff => arith (SLT,slt,slti) stuff
262: | BEQ(b, Reg op1, Reg op2, ref dest) =>
263: if size = 1 then
264: gen1(emit((if b then beq else bne)(op1,op2,dest-(pos+1))))
265: else gen(pos,pcptr,
266: (ref 1, BEQ(not b, Reg op1, Reg op2, ref(pos+size)))
267: ::(ref (size-2),
268: ADD(Reg pcreg, Immed(4*(dest-(get pcptr))), Reg tempreg))
269: ::(ref 1, JUMP(Reg tempreg))
270: ::rest)
271: | JUMP(Reg dest) => gen1(emit(jr(dest)))
272: | SLT_D (Reg op1, Reg op2) =>
273: gen1(emit(c_lt(D_fmt,op1,op2)))
274: | SEQ_D (Reg op1, Reg op2) =>
275: gen1(emit(c_seq(D_fmt,op1,op2)))
276: | BCOP1(b, ref dest) =>
277: let fun bc1f offset = cop1(8,0,offset)
278: fun bc1t offset = cop1(8,1,offset)
279: in if size = 1 then
280: gen1(emit((if b then bc1t else bc1f)(dest-(pos+1))))
281: else gen(pos,pcptr,
282: (ref 1, BCOP1(not b, ref(pos+size)))
283: ::(ref (size-2),
284: ADD(Reg pcreg, Immed(4*(dest-(get pcptr))), Reg tempreg))
285: ::(ref 1, JUMP(Reg tempreg))
286: ::rest)
287: end
288: | NOP => gen1(emit(add(0,0,0))) (* one of the many MIPS no-ops *)
289: | LOAD (Byte,dest,address,offset) => memop(lbu,dest,address,offset)
290: | LOAD (Word,dest,address,offset) => memop(lw,dest,address,offset)
291: | LOAD (Floating,dest,address,offset) => memop(lwc1,dest,address,offset)
292: | STORE (Byte,dest,address,offset) => memop(sb,dest,address,offset)
293: | STORE (Word,dest,address,offset) => memop(sw,dest,address,offset)
294: | STORE (Floating,dest,address,offset) => memop(swc1,dest,address,offset)
295: | SLL (Immed shamt, Reg op1, Reg result) => gen1(
296: if (shamt >= 0 andalso shamt < 32) then emit(sll(result,op1,shamt))
297: else ErrorMsg.impossible ("bad sll shamt "
298: ^ (Integer.makestring shamt) ^ " in mipscoder"))
299: | SLL (Direct(Reg shamt), Reg op1, Reg result) =>
300: gen1(emit(sllv(result,op1,shamt)))
301: | SLL (Immedlab _,_,_) => ErrorMsg.impossible "sll shamt is Immedlab in mipscoder"
302: | SRA (Immed shamt, Reg op1, Reg result) => gen1(
303: if (shamt >= 0 andalso shamt < 32) then emit(sra(result,op1,shamt))
304: else ErrorMsg.impossible ("bad sra shamt "
305: ^ (Integer.makestring shamt) ^ " in mipscoder"))
306: | SRA (Direct(Reg shamt), Reg op1, Reg result) =>
307: gen1(emit(srav(result,op1,shamt)))
308: | SRA (Immedlab _,_,_) => ErrorMsg.impossible "sra shamt is Immedlab in mipscoder"
309: | COMMENT _ => gen1()
310: | MARK => gen1(
311: let open System.Tags
312: in emitlong((pos+1) * power_tags + tag_backptr)
313: end)
314: end
315: | NONE =>
316: let fun easize (Direct _) = 1
317: | easize (Immed i) = if abs(i)<32768 then 1 else 3
318: | easize (Immedlab(ref lab)) = 1 + easize(Immed (4*(lab-(get pcptr))))
319: fun movesize (Direct _) = 1
320: | movesize (Immed i) = if abs(i)<32768 then 1 else 2
321: | movesize (Immedlab(ref lab)) = easize(Immed (4*(lab-(get pcptr))))
322:
323: fun adrsize(_, Reg _, Direct _, offset) =
324: if abs(offset)<32768 then 1 else 3
325: | adrsize(_, Reg _, Immed address, offset) =
326: if abs(address+offset) < 32768 then 1 else 2
327: | adrsize(x, Reg dest, Immedlab (ref lab), offset) =
328: adrsize(x, Reg dest, Direct (Reg 0 (* pcreg in code *) ),
329: offset+4*(lab-(get pcptr)))
330: val newsize = case inst of
331: STRINGCONST s => Integer.div(String.length(s)+3,4)
332: | REALCONST _ => 2
333: | EMITLONG _ => 1
334: | DEFINE _ => ErrorMsg.impossible "generate code for DEFINE in mipscoder"
335: | EMITLAB _ => 1
336: | ADD(_, ea, _) => easize ea
337: | AND(_, ea, _) => easize ea
338: | OR (_, ea, _) => easize ea
339: | XOR(_, ea, _) => easize ea
340: | SUB _ => 1
341: | MULDIV _ => 1
342: | MFLO _ => 1
343: | MFHI _ => 1
344: | NEG_D _ => 1
345: | MUL_D _ => 1
346: | DIV_D _ => 1
347: | ADD_D _ => 1
348: | SUB_D _ => 1
349: | MOVE (src,_) => movesize src
350: | LDI_32 _ => 2
351: | LUI _ => 1
352: | SLT(_, ea, _) => easize ea
353: | BEQ(_,_,_,ref dest) =>
354: if abs((pos+1)-dest) < 32768 then 1 (* single instruction *)
355: else 2+easize (Immed (4*(dest-(get pcptr))))
356: | JUMP _ => 1
357: | SLT_D _ => 1
358: | SEQ_D _ => 1
359: | BCOP1(_,ref dest) =>
360: if abs((pos+1)-dest) < 32768 then 1 (* single instruction *)
361: else 2+easize (Immed (4*(dest-(get pcptr))))
362: | NOP => 1
363: | LOAD x => adrsize x
364: | STORE x => adrsize x
365: | SLL _ => 1
366: | SRA _ => 1
367: | COMMENT _ => 0
368: | MARK => 1 (* backpointer takes one word *)
369: in if newsize > size then sizeref := newsize else ();
370: gen(pos+(!sizeref) (* BUGS -- was pos+size*),pcptr,rest)
371: end
372: in gen
373: end
374:
375: fun prepare instrs =
376: let fun add_positions(done, inst::rest) =
377: add_positions( (ref 0, inst) :: done, rest)
378: | add_positions(done, nil) = done
379:
380: val instrs' = add_positions(nil, instrs) (* reverse and add [[ref int]]s*)
381:
382: fun passes(oldsize) =
383: (* make passes with no emission until size is stable*)
384: let val size = pass NONE (0,NONE,instrs')
385: in if size=oldsize then size
386: else passes size
387: end
388: in {size = passes 0, stream = instrs'}
389: end
390:
391: fun assemble emitters instrs =
392: pass (SOME emitters) (0,NONE,#stream (prepare instrs))
393:
394:
395: fun codegen emitters = (
396: assemble emitters (!kept);
397: kept := nil
398: )
399:
400: fun printstats stream
401: {inst : int, code : int, data : int,
402: load : int, branch : int, compare : int, size : int} =
403: let val print = output stream
404: val nop = load+branch+compare
405: val bltzal = size - (code + data)
406: val code = code + bltzal
407: val I = Integer.makestring
408: val R = Real.makestring
409: exception Printf
410: fun sprintf format values =
411: let fun merge([x],nil) = [x]
412: | merge(nil,nil) = nil
413: | merge(x::y,z::w) = x::z:: merge(y,w)
414: | merge _ = raise Printf
415: in implode(merge(format,values))
416: end
417:
418: fun P x = substring(makestring(100.0 * x),0,4) (* percent *)
419: fun printf f d = print (sprintf f d)
420: in printf ["Counted "," instrs in "," words (",
421: " code, "," data)\n" ^
422: "Used "," NOPs ("," load, "," branch,"," compare) and "," bltzals\n" ^
423: "","% of code words were NOPs; ","% were bltzals\n" ^
424: "","% of all words were code; ","% of all words were NOPs\n"]
425: [I inst, I size, I code, I data,
426: I nop, I load, I branch, I compare, I bltzal,
427: P (real nop / real code), P (real bltzal / real code),
428: P (real code / real size), P (real nop / real size)]
429: handle Overflow => print "[Overflow in computing Mips stats]\n"
430: | Real s => print ("[FPE ("^s^") in computing Mips stats]\n")
431: end
432:
433: val iscode = fn
434: STRINGCONST _ => false
435: | REALCONST _ => false
436: | EMITLONG _ => false
437: | DEFINE _ => false
438: | EMITLAB _ => false
439:
440: | SLT _ => true
441: | BEQ _ => true
442: | JUMP _ => true
443: | NOP => true
444: | SLT_D _ => true
445: | SEQ_D _ => true
446: | BCOP1 _ => true
447:
448: | ADD _ => true
449: | AND _ => true
450: | OR _ => true
451: | XOR _ => true
452: | SUB _ => true
453: | MULDIV _ => true
454: | MFLO _ => true
455: | MFHI _ => true
456:
457: | NEG_D _ => true
458: | MUL_D _ => true
459: | DIV_D _ => true
460: | ADD_D _ => true
461: | SUB_D _ => true
462:
463: | MOVE _ => true
464: | LDI_32 _ => true
465: | LUI _ => true
466:
467: | LOAD _ => true
468: | STORE _ => true
469:
470: | SLL _ => true
471: | SRA _ => true
472:
473: | COMMENT _ => false
474: | MARK => false
475:
476: fun addstats (counts as {inst,code,data,load,branch,compare}) =
477: fn nil => counts
478: | (sizeref,first)::(_,NOP)::rest => addstats
479: {inst=inst+2, code=code+(!sizeref)+1, data=data,
480: load=load+ (case first of LOAD _ => 1 | _ => 0),
481: branch=branch +(case first of BEQ _ => 1 | JUMP _ => 1
482: | BCOP1 _ => 1 | _ => 0),
483: compare=compare+(case first of SLT_D _ => 1 | SEQ_D _ => 1
484: | _ => 0)
485: } rest
486: | (sizeref,first)::rest => addstats
487: {inst=inst+1,
488: code = code + if iscode(first) then !sizeref else 0,
489: data = data + if not (iscode first) then !sizeref else 0,
490: load=load,
491: branch=branch,
492: compare=compare
493: } rest
494:
495:
496: fun codestats outfile =
497: let val {size,stream=instrs} = prepare (!kept)
498: val zero = {inst=0, code=0, data=0, load=0, branch=0, compare=0}
499: val counts as {inst,code,data,load,branch,compare} =
500: addstats zero instrs
501: in printstats outfile
502: {inst=inst,code=code,data=data,
503: load=load,branch=branch,compare=compare,size=size}
504: end
505:
506:
507: end (* MipsInstr *)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.