![[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.