![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to mips.nw 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 mips.nw CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / mips |
1.1 root 1: \section{Using [[MIPSCODER]] to implement a [[CMACHINE]]}
2:
3: <<*>>=
4: functor MipsCM(MipsC : MIPSCODER) : CMACHINE = struct
5:
6: open MipsC System.Tags
7:
8: <<utility functions>>
9:
10: <<immediate and register functions>>
11:
12: <<register definitions>>
13:
14: <<move>>
15: <<alignment, marks, and constants>>
16: <<labels>>
17: <<record manipulation>>
18: <<indexed fetch and store (byte)>>
19: <<indexed fetch and store (word)>>
20: <<arithmetic>>
21: <<shifts>>
22: <<arithmetic and shifts with overflow detection>>
23: <<bitwise operations>>
24: <<branches>>
25:
26: <<floating point>>
27:
28: <<memory check>>
29:
30: <<omitted functions>>
31:
32: val comment = M.comment
33:
34: (* +DEBUG *)
35: <<DEBUG code>>
36: (* -DEBUG *)
37:
38: end (* MipsCM *)
39:
40: @ The debugging code replaces possibly offensive functions with functions
41: that diagnose their own exceptions.
42: <<DEBUG code>>=
43: fun diag (s : string) f x =
44: f x handle e =>
45: (print "?exception "; print (System.exn_name e);
46: print " in mips."; print s; print "\n";
47: raise e)
48:
49: <<immediate and register functions>>=
50: val immed = Immed
51: fun isimmed(Immed i) = SOME i
52: | isimmed _ = NONE
53:
54: fun isreg(Direct(Reg i)) = SOME i | isreg _ = NONE
55: fun eqreg (a: EA) b = a=b
56:
57:
58: @ Here's what our register conventions are:
59: \input regs
60: <<register definitions>>=
61: val standardarg = Direct(Reg 2)
62: val standardcont = Direct(Reg 3)
63: val standardclosure = Direct(Reg 4)
64: val miscregs = map (Direct o Reg) [5,6,7,8,9,10,11,12,13,14,
65: 15,16,17,18,19]
66: val storeptr as Direct storeptr' = Direct(Reg 22)
67: val dataptr as Direct dataptr' = Direct(Reg 23)
68: val exnptr = Direct(Reg 30)
69:
70: (* internal use only *)
71: val my_arithtemp as Direct my_arithtemp'= Direct(Reg 20)
72: val my_ptrtemp as Direct my_ptrtemp' = Direct(Reg 21)
73:
74: (* exported for external use *)
75: val arithtemp as Direct arithtemp' = Direct(Reg 24)
76: val arithtemp2 as Direct arithtemp2'= Direct(Reg 25)
77:
78: <<move>>=
79: fun move (src,Direct dest) = M.move(src, dest)
80: | move _ = ErrorMsg.impossible "destination of move not register in mips"
81: <<alignment, marks, and constants>>=
82: val align = M.align
83: val mark = M.mark
84:
85: val emitlong = M.emitlong
86: val realconst = M.realconst
87: val emitstring = M.emitstring
88:
89: <<labels>>=
90: fun emitlab(i,Immedlab lab) = M.emitlab(i,lab)
91: | emitlab _ = ErrorMsg.impossible "bad emitlab arg in mips"
92: fun newlabel() = Immedlab(M.newlabel())
93: fun define (Immedlab lab) = M.define lab
94: | define _ = ErrorMsg.impossible "bad define arg in mips"
95: <<DEBUG code>>=
96: val emitlab = diag "emitlab" emitlab
97: val define = diag "define" define
98:
99:
100: @ We only ever put the address of a newly created record into a register.
101: If I make this out correctly, the first word on the list of
102: values [[vl]] is actually a descriptor.
103: BUGS: The original routine put the address of the descriptor
104: into [[z]].
105: What needs to go into [[z]] is the address of the first word in the record.
106: We can get this by adding 4 to the [[dataptr']].
107: <<record manipulation>>=
108: fun record(vl, Direct z) =
109: let open CPS
110: val len = List.length vl
111: fun f(i,nil) = ()
112: | f(i,(r, SELp(j,p))::rest) = (* follow ptrs to get the item *)
113: (M.lw(my_ptrtemp', r, j*4); f(i,(my_ptrtemp,p)::rest))
114: | f(i,(Direct r,OFFp 0)::rest) = (* simple store, last first *)
115: (M.sw(r, dataptr, i*4); f(i-1,rest))
116: | f(i,(Direct r, OFFp j)::rest) =
117: (M.add(r, Immed(4*j), my_ptrtemp');
118: f(i,(my_ptrtemp,OFFp 0)::rest))
119: | f(i,(ea,p)::rest) = (* convert to register-based *)
120: (M.move(ea, my_ptrtemp'); f(i,(my_ptrtemp,p)::rest))
121: in f(len - 1, rev vl); (* store first word in [[0(dataptr')]] *)
122: M.add(dataptr', Immed 4, z);
123: M.add(dataptr', Immed(4*len), dataptr')
124: end
125: | record _ = ErrorMsg.impossible "result of record not register in mips"
126:
127: fun select(i, r, Direct s) = M.lw(s, r, i*4)
128: | select _ = ErrorMsg.impossible "result of select not register in mips"
129:
130: fun offset(i, Direct r, Direct s) = M.add(r,Immed(i*4), s)
131: | offset _ = ErrorMsg.impossible "nonregister arg to offset in mips"
132: <<DEBUG code>>=
133: val record = diag "record" record
134: val select = diag "select" select
135: val offset = diag "offset" offset
136:
137: @ For the indexed fetch and store, arithtemp is {\em not} tagged---the
138: tags are removed at a higher level (in {\tt generic.sml}).
139: These could be made faster for the case when they're called with immediate
140: constants as [[x]].
141: <<indexed fetch and store (byte)>>=
142: (* fetchindexb(x,y) fetches a byte: y <- mem[x+arithtemp]
143: y cannot be arithtemp *)
144: fun fetchindexb(x,Direct y) =
145: (M.add(arithtemp',x,my_arithtemp');
146: M.lbu(y,my_arithtemp,0))
147: | fetchindexb _ = ErrorMsg.impossible "fetchb result not register in mips"
148:
149: (* storeindexb(x,y) stores a byte: mem[y+arithtemp] <- x; *)
150: fun storeindexb(Direct x,y) =
151: (M.add(arithtemp',y,my_arithtemp');
152: M.sb(x,my_arithtemp,0))
153: | storeindexb _ = ErrorMsg.impossible "storeb arg not register in mips"
154:
155: (* jmpindexb(x) pc <- (x+arithtemp) *)
156: fun jmpindexb x = (M.add(arithtemp',x,my_arithtemp');
157: M.jump(my_arithtemp'))
158:
159: <<DEBUG code>>=
160: val fetchindexb = diag "fetchindexb" fetchindexb
161: val storeindexb = diag "storeindexb" storeindexb
162: val jmpindexb = diag "jmpindexb" jmpindexb
163:
164:
165: @ Here it looks like [[z]] is a tagged integer number of words,
166: so that [[2*(z-1)]] converts to the appropriate byte offset.
167: But I'm just guessing.
168: In any case, it saves an instruction to compute [[2*z]] (actually [[z+z]])
169: and
170: load (or store) with offset [[~2]].
171:
172: Anything stored with [[storeindexl]] is being put into an array, so it
173: is safe to treat it as a pointer.
174: <<indexed fetch and store (word)>>=
175: (* fetchindexl(x,y,z) fetches a word: y <- mem[x+2*(z-1)] *)
176: (* storeindexl(x,y,z) stores a word: mem[y+2*(z-1)] <- x *)
177:
178: fun fetchindexl(x,Direct y, Direct z) =
179: (M.sll(Immed 1,z,my_arithtemp');
180: M.add(my_arithtemp',x,my_arithtemp');
181: M.lw(y, my_arithtemp,~2))
182: | fetchindexl(x,Direct y, Immed z) = M.lw(y, x, z+z-2)
183: | fetchindexl _ = ErrorMsg.impossible "fetchl result not register in mips"
184:
185: fun storeindexl(Direct x,y, Immed 1) = M.sw(x,y,0)
186: | storeindexl(Direct x,y,Direct z) =
187: (M.sll(Immed 1,z,my_arithtemp');
188: M.add(my_arithtemp',y,my_arithtemp');
189: M.sw(x, my_arithtemp,~2))
190: | storeindexl(Direct x,y,Immed z) = M.sw(x,y,z+z-2)
191:
192: | storeindexl(Direct _,_,Immedlab _) =
193: ErrorMsg.impossible "storeindexl(Direct _,_,Immedlab _) in mips"
194:
195: | storeindexl(Immedlab label,y,z) =
196: (M.move(Immedlab label,my_ptrtemp');
197: storeindexl(my_ptrtemp,y,z))
198:
199: | storeindexl(Immed constant,y,offset) =
200: (M.move(Immed constant,my_ptrtemp');
201: storeindexl(my_ptrtemp,y,offset))
202:
203: <<DEBUG code>>=
204: val fetchindexl = diag "fetchindexl" fetchindexl
205: val storeindexl = diag "storeindexl" storeindexl
206:
207:
208: @ The function [[three]] makes commutative three-operand
209: instructions easier to call.
210: All three operands become [[EA]]s, and it is enough if either of the
211: first two operands is a register.
212: <<utility functions>>=
213: fun three f (Direct x, ea, Direct y) = f(x,ea,y)
214: | three f (ea, Direct x, Direct y) = f(x,ea,y)
215: | three f _ =ErrorMsg.impossible "neither arg to three f is register in mips"
216:
217: @ I assume that shifts are only ever done on arithmetic quantities,
218: not pointers, so that I am justified in using [[my_arithtemp']] to
219: store intermediate values. This is consistent with being unwilling
220: to shift things matching [[Immedlab _]].
221: Appel agrees that pointers aren't shifted, as far as he can remember.
222: <<shifts>>=
223: fun ashr(shamt, Direct op1, Direct result) = M.sra(shamt,op1,result)
224: | ashr(shamt, Immed op1, Direct result) =
225: (M.move(Immed op1,my_arithtemp'); M.sra(shamt,my_arithtemp',result))
226: | ashr _ = ErrorMsg.impossible "ashr args don't match in mips"
227: fun ashl(shamt, Direct op1, Direct result) = M.sll(shamt,op1,result)
228: | ashl(shamt, Immed op1, Direct result) =
229: (M.move(Immed op1,my_arithtemp'); M.sll(shamt,my_arithtemp',result))
230: | ashl _ = ErrorMsg.impossible "ashl args don't match in mips"
231: <<DEBUG code>>=
232: val ashr = diag "ashr" ashr
233: val ashl = diag "ashl" ashl
234:
235: <<bitwise operations>>=
236: val orb = three M.or
237: val andb = three M.and'
238: fun notb (a,b) = subl3(a, Immed ~1, b) (* ~1 - a == one's complement *)
239: val xorb = three M.xor
240: <<DEBUG code>>=
241: val orb = diag "orb" orb
242: val andb = diag "andb" andb
243: val notb = diag "notb" notb
244: val xorb = diag "xorb" xorb
245:
246:
247: @ Subtraction may appear a bit odd.
248: The MIPS machine instruction and [[MIPSCODER.sub]] both subtract
249: their second operand from their first operand.
250: The VAX machine instruction and [[CMACHINE.subl3]] both subtract
251: their first operand from their second operand.
252: This will certainly lead to endless confusion.
253: <<arithmetic>>=
254: val addl3 = three M.add
255:
256: fun subl3(Immed k, x, y) = addl3(x, Immed(~k), y)
257: | subl3(Direct x, Direct y, Direct z) = M.sub(y,x,z)
258: | subl3(x, Immed k, dest) =
259: (M.move(Immed k, my_arithtemp');
260: subl3(x, my_arithtemp, dest))
261: | subl3 _ = ErrorMsg.impossible "subl3 args don't match in mips"
262:
263: @ We assume that any quantities being multiplied are arithmetic
264: quantities, not pointers.
265: <<arithmetic>>=
266: fun mull2(Direct x, Direct y) = M.mult(y,x,y)
267: | mull2(Immed x, Direct y) = (M.move(Immed x,my_arithtemp');
268: M.mult(y,my_arithtemp',y))
269: | mull2 _ = ErrorMsg.impossible "mull2 args don't match in mips"
270: fun divl2(Direct x, Direct y) = M.div(y,x,y)
271: | divl2(Immed x, Direct y) = (M.move(Immed x,my_arithtemp');
272: M.div(y,my_arithtemp',y))
273: | divl2 _ = ErrorMsg.impossible "divl2 args don't match in mips"
274:
275: <<DEBUG code>>=
276: val addl3 = diag "addl3" addl3
277: val subl3 = diag "subl3" subl3
278: val mull2 = diag "mull2" mull2
279: val divl2 = diag "divl2" divl2
280:
281:
282: @ The Mips hardware detects two's complement integer overflow on
283: add and subtract instructions only.
284: The exception is not maskable (see the Mips book, page 5-18).
285: At the moment we don't implement any overflow detection for multiplications
286: or for left shifts.
287: This has consequences only for coping with real constants and for
288: compiling user programs.
289: <<arithmetic and shifts with overflow detection>>=
290: val addl3t = addl3
291: val subl3t = subl3
292: @ The Mips multiplies two 32-bit quantities to get a 64-bit result.
293: That result fits in 32 bits if and only if the high-order word is zero or
294: negative one, and it has the same sign as the low order word.
295: Thus, we can add the sign bit of the low order word to the high order
296: word, and we have overflow if and only if the result is nonzero.
297: <<arithmetic and shifts with overflow detection>>=
298: fun mull2t(x,y as Direct y') =
299: let val ok = M.newlabel()
300: in mull2(x,y);
301: M.mfhi(my_arithtemp');
302: M.slt(y',Direct (Reg 0),my_ptrtemp'); (* 0 or 1 OK in pointer *)
303: M.add(my_arithtemp',my_ptrtemp,my_arithtemp');
304: M.beq(true,my_arithtemp',Reg 0,ok); (* OK if not overflow *)
305: M.lui(my_arithtemp',32767);
306: M.add(my_arithtemp',my_arithtemp,my_arithtemp'); (* overflows *)
307: M.define(ok)
308: end
309: | mull2t _ = ErrorMsg.impossible "result of mull2t not register in mips"
310:
311: <<DEBUG code>>=
312: val addl3t = diag "addl3t" addl3t
313: val subl3t = diag "subl3t" subl3t
314: val mull2t = diag "mull2t" mull2t
315: val ashlt = diag "ashlt" ashlt
316:
317:
318: @ We hack [[ibranch]] to make sure it will only reverse once.
319: It's easier than thinking.
320: <<branches>>=
321: datatype condition = NEQ | EQL | LEQ | GEQ | LSS | GTR
322: local
323: fun makeibranch reverse =
324: let
325: fun ibranch (cond, Immed a, Immed b, Immedlab label) =
326: if (case cond of EQL => a=b | NEQ => a<>b | LSS => a<b |
327: LEQ => a<=b | GTR => a>b | GEQ => a>=b)
328: then M.beq(true,Reg 0, Reg 0, label) else ()
329: | ibranch (NEQ, Direct r, Direct s, Immedlab label) =
330: M.beq(false, r, s, label)
331: | ibranch (NEQ, Direct r, x, Immedlab label) =
332: (M.move(x, my_arithtemp');
333: M.beq(false, r, my_arithtemp', label))
334: | ibranch (EQL, Direct r, Direct s, Immedlab label) =
335: M.beq(true, r, s, label)
336: | ibranch (EQL, Direct r, x, Immedlab label) =
337: (M.move(x, my_arithtemp');
338: M.beq(true, r, my_arithtemp', label))
339: | ibranch (LSS, Direct r, x, Immedlab lab) =
340: (M.slt(r,x,my_arithtemp');
341: M.beq(false,Reg 0, my_arithtemp',lab))
342: | ibranch (GEQ, Direct r, x, Immedlab lab) =
343: (M.slt(r,x,my_arithtemp');
344: M.beq(true,Reg 0, my_arithtemp',lab))
345: | ibranch (GTR, x, Direct r, Immedlab lab) =
346: (M.slt(r,x,my_arithtemp');
347: M.beq(false,Reg 0, my_arithtemp',lab))
348: | ibranch (LEQ, x, Direct r, Immedlab lab) =
349: (M.slt(r,x,my_arithtemp');
350: M.beq(true,Reg 0, my_arithtemp',lab))
351: (* These two cases added to prevent infinite reversal *)
352: | ibranch (GTR, Direct r, x, Immedlab lab) =
353: (M.move(x, my_arithtemp');
354: M.slt(my_arithtemp',Direct r,my_arithtemp');
355: M.beq(false,Reg 0,my_arithtemp',lab))
356: | ibranch (LEQ, Direct r, x, Immedlab lab) =
357: (M.move(x, my_arithtemp');
358: M.slt(my_arithtemp',Direct r,my_arithtemp');
359: M.beq(true,Reg 0,my_arithtemp',lab))
360: | ibranch (_, Immedlab _, Immedlab _, _) =
361: ErrorMsg.impossible "bad ibranch args 1 in mips"
362: | ibranch (_, Immedlab _, _, _) =
363: ErrorMsg.impossible "bad ibranch args 1a in mips"
364: | ibranch (_, _, Immedlab _, _) =
365: ErrorMsg.impossible "bad ibranch args 1b in mips"
366: | ibranch (_, _, _, Direct _) =
367: ErrorMsg.impossible "bad ibranch args 2 in mips"
368: | ibranch (_, _, _, Immed _) =
369: ErrorMsg.impossible "bad ibranch args 3 in mips"
370: | ibranch (cond, x, y, l) =
371: let fun rev LEQ = GEQ
372: | rev GEQ = LEQ
373: | rev LSS = GTR
374: | rev GTR = LSS
375: | rev NEQ = NEQ
376: | rev EQL = EQL
377: in if reverse then (makeibranch false) (rev cond, y,x,l)
378: else ErrorMsg.impossible "infinite ibranch reversal in mips"
379:
380: end
381: in ibranch
382: end
383: in
384: val ibranch = makeibranch true
385: end
386:
387: <<branches>>=
388: fun jmp (Direct r) = M.jump(r)
389: | jmp (Immedlab lab) = M.beq(true,Reg 0,Reg 0,lab)
390: | jmp (Immed i) = ErrorMsg.impossible "jmp (Immed i) in mips"
391:
392:
393: (* branch on bit set *)
394: fun bbs (Immed k, Direct y, Immedlab label) =
395: (M.and'(y,Immed (Bits.lshift(1,k)),my_arithtemp');
396: M.beq(false,my_arithtemp',Reg 0,label))
397: | bbs _ = ErrorMsg.impossible "bbs args don't match in mips"
398:
399: <<DEBUG code>>=
400: val ibranch = diag "ibranch" ibranch
401: val jmp = diag "jmp" jmp
402: val bbs = diag "bbs" bbs
403:
404: @ We decided not to include floating point registers in our galaxy of
405: effective addresses.
406: This means that floating point registers are used only at this level, and
407: only to contain intermediate results.
408: All operands and final results will be stored in memory, in the usual
409: ML format (i.e. as 8-byte strings).
410:
411: In fact, we can be much more strict than that, and claim that
412: all floating point operands will live in FPR0 and FPR2, and that all
413: results will appear in FPR0.
414:
415: We don't make a distinction between general-purpose and floating point
416: registers; it's up to the instructions to know the difference.
417: <<floating point>>=
418: val floatop1 = Reg 0
419: val floatop2 = Reg 2
420: val floatresult = Reg 0
421:
422: @ One very common operation is to take the result of a floating point
423: operation and put it into a fresh record, newly allocated on the heap.
424: This operation is traditionally called [[finish_real]], and it takes one
425: argument, the destination register for the new value.
426: All real values on the heap are labelled as 8-byte strings.
427: To store a floating point, we store the least significant
428: word in the lower address, but we store the most significant word
429: first, in case that triggers a garbage collection.
430: <<floating point>>=
431: val real_tag = Immed(8*System.Tags.power_tags + System.Tags.tag_string)
432:
433: fun store_float(Reg n,ea,offset) =
434: if n mod 2 <> 0 then ErrorMsg.impossible "bad float reg in mips"
435: else (M.swc1(Reg (n+1),ea,offset+4);M.swc1(Reg n,ea,offset))
436:
437: fun finish_real (Direct result) = (
438: store_float(floatresult,dataptr,4);
439: M.move(real_tag,my_arithtemp');
440: M.sw(my_arithtemp',dataptr,0);
441: M.add(dataptr',Immed 4,result);
442: M.add(dataptr',Immed 12,dataptr'))
443: | finish_real _ =
444: ErrorMsg.impossible "ptr to result of real operation not register in mips"
445:
446: @ Loading a floating point quantity is analogous.
447: <<floating point>>=
448: fun load_float(Reg dest,src,offset) =
449: if dest mod 2 <> 0 then ErrorMsg.impossible "bad float reg in mips"
450: else (M.lwc1(Reg dest,src,offset); M.lwc1(Reg (dest+1),src,offset+4))
451:
452: @ Now we can do a general two- and three-operand floating point operationa.
453: The only parameter is the function in [[MipsCoder]] that
454: emits the floating point register operation.
455: <<floating point>>=
456: fun two_float instruction (op1,result) = (
457: load_float(floatop1,op1,0);
458: instruction(floatop1,floatresult);
459: finish_real(result))
460:
461: fun three_float instruction (op1,op2,result) = (
462: load_float(floatop1,op1,0);
463: load_float(floatop2,op2,0);
464: instruction(floatop1,floatop2,floatresult);
465: finish_real(result))
466:
467: @ That takes care of everything except branch
468: <<floating point>>=
469: val mnegg = two_float M.neg_double
470: val mulg3 = three_float M.mul_double
471: val divg3 = three_float M.div_double
472: val addg3 = three_float M.add_double
473: val subg3 = three_float M.sub_double
474:
475:
476: @ The Mips doesn't provide all six comparisons in hardware, so the
477: next function does the comparison using only less than and equal.
478: The result tells [[bcop1]] whether to branch on condition true
479: or condition false.
480: <<floating point compare>>=
481: fun compare(LSS,op1,op2) = (M.slt_double(op1,op2); true)
482: | compare(GEQ,op1,op2) = (M.slt_double(op1,op2); false)
483: | compare(EQL,op1,op2) = (M.seq_double(op1,op2); true)
484: | compare(NEQ,op1,op2) = (M.seq_double(op1,op2); false)
485: | compare(LEQ,op1,op2) = compare(GEQ,op2,op1)
486: | compare(GTR,op1,op2) = compare(LSS,op2,op1)
487: <<floating point>>=
488: local
489: <<floating point compare>>
490: in
491: fun gbranch (cond, op1, op2, Immedlab label) = (
492: load_float(floatop1,op1,0);
493: load_float(floatop2,op2,0);
494: M.bcop1(compare(cond,floatop1,floatop2),label))
495: | gbranch _ = ErrorMsg.impossible "insane gbranch target in mips.nw"
496: end
497:
498:
499: @ When a function begins execution, it checks to make sure there is sufficient
500: memory available that it can do all its allocation.
501: generic does this by calling [[checkLimit : int -> unit]].
502: At the moment, we implement this check by doing a store,
503: taking advantage of the virtual memory hardware, which will cause an exception
504: if there's not enough memory.
505: Later we will replace this store with a check against a limit register,
506: which will avoid virtual memory hacking and which will have advantages
507: for concurrency.
508: <<memory check>>=
509: fun checkLimit max_allocation = M.sw(Reg 0, dataptr, max_allocation-4)
510: (* store zero in last location to be used *)
511:
512: @ These two functions have null implementations.
513: [[beginStdFn]] is necessary only on the SPARC, since that machine needs to get
514: its program counter, and it is awkward to do so in the middle of a function.
515:
516: [[profile]] is a mysterious relic.
517: <<omitted functions>>=
518: fun beginStdFn _ = () (* do nothing, just like the Vax *)
519:
520: fun profile(i,incr) = ()
521:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.