![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to coder.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 / coder|
Return to coder.sml CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / coder |
1.1 root 1: (* Copyright 1989 by AT&T Bell Laboratories *)
2: (* coder.sml
3: *
4: * J.H. Reppy
5: * Cornell University
6: * Ithaca, NY 14853
7: * [email protected]
8: *
9: * HISTORY:
10: * 11/20/89 created
11: *
12: * This is a machine independent code scheduler for RISC machines with 32-bit
13: * instructions. We assume that the machine has delayed branches.
14: *)
15:
16: signature CODER =
17: sig
18: eqtype label sharing type label = BaseCoder.label
19: type instruction
20: type sdi
21:
22: val baseLab : label (* The symbolic base address of the current code block. *)
23:
24: val newLabel : unit -> label
25: val define : label -> unit
26:
27: val emitLong : int -> unit
28: val emitString : string -> unit
29: val emitReal : string -> unit
30: val emitLabel : (label * int) -> unit
31: (* L3: emitLabel(L2, k) is equivalent to L3: emitLong(k+L2-L3) *)
32:
33: val mark : unit -> unit
34:
35: val emit : instruction -> unit
36: val delay : instruction -> unit
37: val emitSDI : sdi -> unit
38:
39: val comment : string -> unit
40:
41: val finish : unit -> unit
42:
43: end (* signature CODER *)
44:
45: functor Coder (
46: structure M : MACHINSTR and E : EMITTER
47: sharing type M.instruction = E.instruction
48: and type M.label = E.label) : CODER =
49: struct
50:
51: open BaseCoder M
52:
53: datatype sdi_nd = SDI_ND of {
54: instr : sdi,
55: size : int ref
56: }
57:
58: datatype data
59: = LABEL of label
60: | MARK
61: | LONGconst of int
62: | STRINGconst of string
63: | REALconst of string
64: | ADDRconst of (label * int)
65:
66: datatype blk_list
67: = CODEBLK of (instruction list * blk_list)
68: | SDI of (sdi_nd * blk_list)
69: | DATABLK of (data list * blk_list)
70: | NILBLK
71:
72: fun revCode l = let
73: fun rev (NILBLK, l) = l
74: | rev (CODEBLK(x, rest), l) = rev(rest, CODEBLK(x, l))
75: | rev (SDI(x, rest), l) = rev(rest, SDI(x, l))
76: | rev (DATABLK(x, rest), l) = rev(rest, DATABLK(x, l))
77: in
78: rev (l, NILBLK)
79: end
80:
81: datatype codept
82: = NILpt
83: | LABELpt of (label * codept)
84: | SDIpt of (sdi_nd * codept)
85:
86: val baseLab = newLabel() (* The base address of the current code block. *)
87:
88: val codeList = ref (DATABLK([LABEL baseLab], NILBLK))
89: val codePtList = ref NILpt
90: val codeLen = ref 0
91: val numSlots = ref 0
92: val numNops = ref 0
93:
94: fun emitCode I = (codeList :=
95: case !codeList
96: of (CODEBLK(cl, rest)) => CODEBLK(I::cl, rest)
97: | lst => CODEBLK([I], lst))
98:
99: (* Insert an instruction/nop pair into the code list. If the instruction is a jump,
100: * then start a DATABLK to insure that the jump is the end of a code block. *)
101: fun emitDelay I = let
102: val clst = case !codeList
103: of (CODEBLK(cl, rest)) => CODEBLK(nop::I::cl, rest)
104: | lst => CODEBLK([nop, I], lst)
105: in
106: codeList :=
107: case (instrKind I) of IK_JUMP => DATABLK(nil, clst) | _ => clst
108: end
109:
110: fun emitData D = (codeList :=
111: case !codeList
112: of (DATABLK(dl, rest)) => DATABLK(D::dl, rest)
113: | lst => DATABLK([D], lst))
114:
115: fun reset () = (
116: codeList := DATABLK([LABEL baseLab], NILBLK);
117: codePtList := NILpt; codeLen := 0;
118: numSlots := 0; numNops := 0)
119:
120: fun padString s = (case ((size s) mod 4)
121: of 0 => s
122: | 1 => (s ^ "\000\000\000")
123: | 2 => (s ^ "\000\000")
124: | 3 => (s ^ "\000"))
125:
126: fun emitLong i = (
127: emitData (LONGconst i);
128: codeLen := !codeLen + 4)
129:
130: fun emitString s = let
131: val s' = padString s
132: in
133: emitData (STRINGconst s');
134: codeLen := !codeLen + (size s')
135: end
136:
137: fun emitReal r = (
138: emitData (REALconst r);
139: codeLen := !codeLen + 8)
140:
141: fun emitLabel args = (
142: emitData (ADDRconst args);
143: codeLen := !codeLen + 4)
144:
145: fun define (l as Label{addr, ...}) = (
146: addr := !codeLen;
147: codePtList := LABELpt(l, !codePtList);
148: emitData (LABEL l))
149:
150: fun mark () = (emitData MARK; codeLen := !codeLen + 4)
151:
152: fun emit I = (emitCode I; codeLen := !codeLen + 4)
153: fun delay I = (emitDelay I; codeLen := !codeLen + 8)
154:
155: fun emitSDI I = let
156: val minSz = minSize I
157: val nd = SDI_ND{instr = I, size = ref minSz}
158: in
159: codeList := SDI(nd, !codeList);
160: codePtList := SDIpt(nd, !codePtList);
161: codeLen := !codeLen + minSz
162: end
163:
164: val comment = E.comment
165:
166:
167: fun computeSizes () = let
168: fun reverse l = let (* reverse l and remove leading labels *)
169: fun clean (LABELpt(_, rest)) = clean rest
170: | clean l = l
171: fun rev (NILpt, l) = clean l
172: | rev (LABELpt(lab, rest), l) = rev(rest, LABELpt(lab, l))
173: | rev (SDIpt(lab, rest), l) = rev(rest, SDIpt(lab, l))
174: in
175: rev (l, NILpt)
176: end
177: fun deltaSize (SDI_ND{instr, size}) = let
178: val (isMax, newSz) = sizeOf instr
179: val dsz = newSz - (!size)
180: in
181: if (dsz > 0)
182: then (size := newSz; (isMax, dsz))
183: else (isMax, 0)
184: end
185: fun adjust (NILpt, 0, _) = ()
186: | adjust (NILpt, delta, l) = (
187: codeLen := !codeLen + delta;
188: adjust (reverse l, 0, NILpt))
189: | adjust (LABELpt(lab as Label{addr, ...}, rest), delta, l) = (
190: addr := !addr + delta;
191: adjust(rest, delta, LABELpt(lab, l)))
192: | adjust (SDIpt(sdi, rest), delta, l) = (
193: case (deltaSize sdi)
194: of (true, dsz) => adjust(rest, delta+dsz, l)
195: | (false, dsz) => adjust(rest, delta+dsz, SDIpt(sdi, l)))
196: val codePts = reverse(!codePtList)
197: in
198: codePtList := NILpt;
199: adjust (codePts, 0, NILpt)
200: end (* computeSizes *)
201:
202:
203: (** Instruction scheduling and machine code emission **)
204:
205: datatype instr_nd (* Nodes in the resource dependency graph *)
206: = IND of {
207: id : int, (* unique id for equality testing *)
208: instr : instruction, (* The instruction *)
209: nsuccs : int, (* The number of successors *)
210: succs : instr_nd list,
211: succlock : bool, (* If this instruction has an interlock with one of *)
212: (* its successors, then this is true. *)
213: maxpathlen : int, (* The length of the longest path to a leaf. *)
214: npreds : int ref (* The number of predecessors. This is incremented *)
215: (* when building the graph, and decremented as *)
216: (* each predecessor is scheduled. *)
217: }
218:
219: fun member (IND{id = x, ...}, lst) = let
220: fun mem nil = false
221: | mem (IND{id = y, ...}::rest) = ((x = y) orelse (mem rest))
222: in
223: mem lst
224: end
225:
226: fun merge (nil, lst) = lst
227: | merge (nd :: rest, lst) = if (member(nd, lst))
228: then merge (rest, lst)
229: else merge (rest, nd :: lst)
230:
231: fun incPreds nil = ()
232: | incPreds (IND{npreds, ...} :: rest) = (npreds := !npreds + 1; incPreds rest)
233:
234: (* Order a pair of instructions *)
235: fun orderInstrPair (nd1 as IND a, nd2 as IND b) =
236: if ((#succlock a) = (#succlock b))
237: then let val n1 = (#nsuccs a) and n2 = (#nsuccs b)
238: in
239: if (n1 = n2)
240: then let val p1 = (#maxpathlen a) and p2 = (#maxpathlen b)
241: in
242: if ((p1 > p2) orelse ((p1 = p2) andalso ((#id a) > (#id b))))
243: then (nd1, nd2)
244: else (nd2, nd1)
245: end
246: else if (n1 > n2)
247: then (nd1, nd2)
248: else (nd2, nd1)
249: (********************************
250: if ((n1 > n2)
251: orelse ((n1 = n2) andalso ((#maxpathlen a) >= (#maxpathlen b))))
252: then (nd1, nd2)
253: else (nd2, nd1)
254: ********************************)
255: end
256: else if (#succlock a)
257: then (nd1, nd2)
258: else (nd2, nd1)
259:
260: (* Schedule and emit the instructions of a straight-line block of code. *)
261: fun schedBlock (exitInstr, blks) = let
262: val exitDep = case exitInstr
263: of NONE => (fn _ => false)
264: | (SOME e) => let
265: val (exitUses, exitDefs) = rUseDef e
266: val f = exists (fn r => (exists (fn x => (r = x)) exitUses))
267: val g = exists (fn r => (exists (fn x => (r = x)) exitDefs))
268: in
269: fn I => let
270: val (u, d) = rUseDef I
271: in
272: (f d) orelse (g d) orelse (g u)
273: end
274: end
275: (* make a new instr_nd *)
276: fun mkINd (n, I, nil) =
277: IND{id = n, instr = I,
278: nsuccs = 0, succs = nil, succlock = exitDep I,
279: maxpathlen = 0, npreds = ref 0}
280: | mkINd (n, I, succLst) = let
281: fun f (nil, len, lock, mpl) = (len, lock, mpl)
282: | f (IND{instr, maxpathlen, ...} :: rest, len, lock, mpl) =
283: f (rest, len+1, hazard (I, instr),
284: if (maxpathlen > mpl) then maxpathlen else mpl)
285: val (len, lock, mpl) = f (succLst, 0, false, 0)
286: in
287: IND{id = n, instr = I,
288: nsuccs = len, succs = succLst, succlock = lock,
289: maxpathlen = mpl+1, npreds = ref 0}
290: end
291: (* resource use/def vectors *)
292: val lastUse = array (numResources, nil)
293: val lastDef = array (numResources, nil)
294: (* find resource dependencies *)
295: fun findDeps rsrc = let
296: fun add (nil, lst) = lst
297: | add (r :: rest, lst) = add (rest, merge(rsrc sub r, lst))
298: in
299: add
300: end
301: val findUseDeps = findDeps lastUse
302: val findDefDeps = findDeps lastDef
303: (* update resource use/def vectors *)
304: fun updateUseDefs nd = let
305: val ndl = [nd]
306: val updateUses =
307: app (fn r => update(lastUse, r, nd::(lastUse sub r)))
308: val updateDefs =
309: app (fn r => (update(lastDef, r, ndl); update(lastUse, r, nil)))
310: in
311: fn (ruses, rdefs) => (updateDefs rdefs; updateUses ruses)
312: end
313: (* extract the dependency graph roots from the use/def vectors *)
314: fun roots () = let
315: fun isRoot (IND{npreds, ...}) = (!npreds = 0)
316: fun rootsOf (nil, lst) = lst
317: | rootsOf (nd::rest, lst) = if (isRoot nd)
318: then rootsOf (rest, nd::lst)
319: else rootsOf (rest, lst)
320: fun mergeRoots (~1, lst) = lst
321: | mergeRoots (i, lst) = let
322: val rlst = rootsOf (merge (lastDef sub i, lastUse sub i), nil)
323: in
324: mergeRoots (i-1, merge (rlst, lst))
325: end
326: in
327: mergeRoots (numResources-1, nil)
328: end
329: (* Build the dependency graph for a list of instructions, returning the list
330: * of roots (instructions without predecessors). *)
331: fun buildDepGraph blkList = let
332: fun doInstrs (nil, n) = n
333: | doInstrs (I :: rest, n) = (
334: case (instrKind I)
335: of IK_NOP => (numSlots := !numSlots + 1)
336: | IK_INSTR => let
337: val (ruses, rdefs) = rUseDef I
338: (* find use/def, def/use and def/def dependencies *)
339: val succLst = findUseDeps (rdefs,
340: findDefDeps (rdefs, findDefDeps (ruses, nil)))
341: val nd = mkINd (n, I, succLst)
342: in
343: incPreds succLst;
344: updateUseDefs nd (ruses, rdefs)
345: end
346: | IK_JUMP => (
347: ErrorMsg.impossible "[Coder.doInstrs: unexpected jump]")
348: (* end case *);
349: doInstrs (rest, n+1))
350: fun build (NILBLK, _) = ()
351: | build (CODEBLK(instrs, rest), n) =
352: build (rest, doInstrs (instrs, n))
353: | build _ = ErrorMsg.impossible "[Coder.build: bad block]"
354: in
355: build (blkList, 0)
356: end (* buildDepGraph *)
357:
358: (* Choose the next instruction from a list of candidates. Instructions that
359: * don't interlock with the previously scheduled instruction are given
360: * priority. *)
361: fun chooseNextInstr (prev, (x :: rest)) = let
362: val prevLock = case prev
363: of (NONE) => (fn _ => false)
364: | (SOME prev) => (fn (IND{instr, ...}) => hazard(prev, instr))
365: (* choose1 & choose2 find the best instruction to schedule next.
366: * choose1 is used as long as the current choice interlocks with prev,
367: * choose2 is used after a non-interlocking choice is found. *)
368: fun choose1 (choice, done, nil) = (choice, done)
369: | choose1 (choice, done, nd::rest) = if (prevLock nd)
370: then let
371: val (a, b) = orderInstrPair (choice, nd)
372: in
373: choose1 (a, b::done, rest)
374: end
375: else choose2 (nd, choice::done, rest)
376: and choose2 (choice, done, nil) = (choice, done)
377: | choose2 (choice, done, nd::rest) = if (prevLock nd)
378: then choose2 (choice, nd::done, rest)
379: else let
380: val (a, b) = orderInstrPair (choice, nd)
381: in
382: choose2 (a, b::done, rest)
383: end
384: val (IND{succs, instr, ...}, remainder) = if (prevLock x)
385: then choose1 (x, nil, rest)
386: else choose2 (x, nil, rest)
387: fun addSuccs (nil, candidates) = candidates
388: | addSuccs ((nd as IND{npreds, ...}) :: rest, candidates) = let
389: val n = !npreds
390: in
391: npreds := n-1;
392: if (n = 1)
393: then addSuccs(rest, nd::candidates)
394: else addSuccs(rest, candidates)
395: end
396: in
397: (instr, addSuccs(succs, remainder))
398: end
399: | chooseNextInstr _ = (ErrorMsg.impossible "[Coder.chooseNextInstr]")
400:
401: (* assign an order to the instructions, based on the dependency graph. *)
402: fun assignOrder () = let
403: fun emitNop () = (numNops := !numNops + 1; nop)
404: fun checkLock (i1, i2, cl) = if (needsNop(i1, i2))
405: then (numNops := !numNops + 1; nop :: cl)
406: else cl
407: fun order (NONE, nil, _) = let
408: val (SOME e) = exitInstr
409: in
410: numNops := !numNops + 1;
411: [nop, e]
412: end
413: | order (SOME prev, nil, cl) = (
414: case exitInstr
415: of NONE => (prev :: cl)
416: | (SOME e) => (
417: if (exitDep prev)
418: then (
419: numNops := !numNops + 1;
420: nop :: e :: checkLock(prev, e, prev :: cl))
421: else (prev :: e :: cl))
422: (* end case *))
423: | order (prev, rest, cl) = let
424: val (next, remainder) = chooseNextInstr (prev, rest)
425: val newCL = case prev
426: of (SOME x) => checkLock(x, next, (x :: cl))
427: | NONE => cl
428: in
429: order (SOME next, remainder, newCL)
430: end
431: in
432: rev (order(NONE, roots(), nil))
433: end (* assignOrder *)
434: in
435: buildDepGraph blks;
436: assignOrder ()
437: end (* schedBlock *)
438:
439: fun sched (NILBLK, blst) = blst
440: | sched (DATABLK(dl, rest), blst) = let
441: fun adjust (nil, dl) = dl
442: | adjust ((lab as LABEL(Label{addr, ...})) :: rest, dl) = (
443: addr := !addr - 4*(!numSlots - !numNops);
444: adjust (rest, lab :: dl))
445: | adjust (d :: rest, dl) = adjust(rest, d :: dl)
446: in
447: sched (rest, DATABLK(adjust (dl, nil), blst))
448: end
449: | sched (arg, blst) = let
450: fun insertCode (nil, nil, bl) = bl
451: | insertCode (nil, cl, bl) = CODEBLK(cl, bl)
452: | insertCode (I::rest, cl, bl) = (
453: case (instrKind I)
454: of IK_JUMP =>
455: insertCode ((tl rest), nil, DATABLK(nil, CODEBLK(nop::I::cl, bl)))
456: | _ => insertCode (rest, I::cl, bl))
457: fun findBlk (CODEBLK(cl, rest), lst) = findBlk(rest, CODEBLK(cl, lst))
458: | findBlk (SDI(SDI_ND{instr, size}, rest), lst) =
459: findBlk (insertCode(expand (instr, !size), nil, rest), lst)
460: | findBlk (rest, bl) = (rest, bl)
461: val (rest, b as CODEBLK(cl, bl)) = findBlk (arg, NILBLK)
462: val newCL = (case cl
463: of (i1 :: i2 :: instrs) => (case (instrKind i1, instrKind i2)
464: of (IK_NOP, IK_JUMP) => (
465: numSlots := !numSlots + 1;
466: schedBlock (SOME i2, CODEBLK(instrs, bl)))
467: | _ => schedBlock (NONE, b))
468: | _ => schedBlock (NONE, b))
469: in
470: sched (rest, CODEBLK(newCL, blst))
471: end
472:
473: (* reverse the code list, while expanding SDIs and reversing instruction lists.
474: * This pass is the alternative to the scheduling pass. *)
475: fun noSched (NILBLK, bl) = bl
476: | noSched (CODEBLK(cl, rest), bl) = noSched (rest, CODEBLK(rev cl, bl))
477: | noSched (SDI(SDI_ND{instr, size}, rest), bl) =
478: noSched (rest, CODEBLK(expand(instr, !size), bl))
479: | noSched (DATABLK(dl, rest), bl) = noSched (rest, DATABLK(rev dl, bl))
480:
481: fun finish () = let
482: val emitInstrs = app E.emitInstr
483: fun emitDataList nil = ()
484: | emitDataList (d :: rest) = (case d
485: of (LABEL lab) => E.define lab
486: | MARK => E.mark ()
487: | (LONGconst n) => E.emitLong n
488: | (STRINGconst s) => E.emitString s
489: | (REALconst r) => E.emitReal r
490: | (ADDRconst args) => E.emitAddr args
491: (* end case *);
492: emitDataList rest)
493: fun emitBlk NILBLK = ()
494: | emitBlk (CODEBLK(cl, rest)) = (emitInstrs cl; emitBlk rest)
495: | emitBlk (DATABLK(dl, rest)) = (emitDataList dl; emitBlk rest)
496: | emitBlk _ = (ErrorMsg.impossible "[Coder.finish.emitBlk]")
497: fun schedule cl = if (!System.Control.CG.scheduling)
498: then revCode (sched (revCode cl, NILBLK))
499: else noSched (cl, NILBLK)
500: val _ = computeSizes ()
501: val newCL = schedule (!codeList before (codeList := NILBLK))
502: in
503: E.init (!codeLen - 4*(!numSlots - !numNops));
504: emitBlk newCL;
505: reset()
506: end (* finish *)
507:
508: end (* Coder *)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.