1(* 2 Copyright David C. J. Matthews 2018-20 3 4 This library is free software; you can redistribute it and/or 5 modify it under the terms of the GNU Lesser General Public 6 License version 2.1 as published by the Free Software Foundation. 7 8 This library is distributed in the hope that it will be useful, 9 but WITHOUT ANY WARRANTY; without even the implied warranty of 10 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 Lesser General Public License for more details. 12 13 You should have received a copy of the GNU Lesser General Public 14 License along with this library; if not, write to the Free Software 15 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 16*) 17 18functor X86ICodeOptimise( 19 structure ICODE: ICodeSig 20 structure INTSET: INTSETSIG 21 structure IDENTIFY: X86IDENTIFYREFSSIG 22 structure X86CODE: X86CODESIG (* For invertTest. *) 23 structure DEBUG: DEBUG 24 structure PRETTY: PRETTYSIG 25 sharing ICODE.Sharing = IDENTIFY.Sharing = INTSET = X86CODE 26): X86ICODEOPTSIG = 27struct 28 open ICODE 29 open INTSET 30 open IDENTIFY 31 val InternalError = Misc.InternalError 32 33 datatype optimise = Changed of basicBlock vector * regProperty vector | Unchanged 34 35 (* Optimiser. 36 This could incorporate optimisations done elsewhere. 37 IdentifyReferences currently removes instructions that 38 produce results in registers that are never used. 39 40 PushRegisters deals with caching. Caching involves 41 speculative changes that can be reversed if there is a need 42 to spill registers. 43 44 The optimiser currently deals with booleans and conditions 45 and with moving memory loads into an instruction operand. 46 *) 47 48 (* This is a rewrite of the last instruction to set a boolean. 49 This is almost always rewriting the next instruction. The only 50 possibility is that we have a ResetStackPtr in between. *) 51 datatype boolRegRewrite = 52 BRNone 53 (* BRSetConditionToConstant - we have a comparison of two constant value. 54 This will usually happen because we've duplicated a branch and 55 set a register to a constant which we then compare. *) 56 | BRSetConditionToConstant of 57 { srcCC: ccRef, signedCompare: order, unsignedCompare: order } 58 59 fun optimiseICode{ code, pregProps, ccCount=_, debugSwitches=_ } = 60 let 61 val hasChanged = ref false 62 val regCounter = ref(Vector.length pregProps) 63 val regList = ref [] 64 fun newReg kind = 65 ( 66 regList := kind :: ! regList; 67 PReg (!regCounter) 68 ) before regCounter := !regCounter + 1 69 70 (* If this argument is a register and the register is mapped to a memory location, a constant 71 or another register replace the value. Memory locations are only replaced if this is 72 the only use. If there is more than one reference it's better to load it into a 73 register and retain the register references. *) 74 fun replaceWithValue(arg as RegisterArgument (preg as PReg pregNo), kill, regMap, instrOpSize) = 75 ( 76 case List.find(fn {dest, ... } => dest = preg) regMap of 77 SOME { source as MemoryLocation _, opSize, ...} => 78 ( 79 if member(pregNo, kill) andalso opSize = instrOpSize 80 then ( hasChanged := true; source ) 81 else arg, 82 (* Filter this from the list. If this is not the last 83 reference we want to use the register and if it is then 84 we don't need it any longer. *) 85 List.filter(fn {dest, ...} => dest <> preg) regMap 86 ) 87 | SOME { source, ...} => 88 ( 89 source, 90 (* Filter it if it is the last reference. *) 91 if member(pregNo, kill) 92 then List.filter(fn {dest, ...} => dest <> preg) regMap 93 else regMap 94 ) 95 | NONE => (arg, regMap) 96 ) 97 98 | replaceWithValue(arg, _, regMap, _) = (arg, regMap) 99 100 fun optimiseBlock processed (block, flow, outCCState) = 101 let 102 fun optCode([], brCond, regMap, code) = (code, brCond, regMap) 103 104 | optCode({instr=CompareLiteral{arg1, arg2, ccRef=ccRefOut, opSize}, kill, ...} :: rest, 105 _, regMap, code) = 106 let 107 val (repArg1, memRefsOut) = replaceWithValue(arg1, kill, regMap, opSize) 108 in 109 case repArg1 of 110 IntegerConstant test => 111 (* CompareLiteral is put in by CodetreeToIcode to test a boolean value. It can also 112 arise as the result of pattern matching on booleans or even by tests such as = true. 113 If the source register is now a constant we want to propagate the constant 114 condition. *) 115 let 116 (* This comparison reduces to a constant. *) 117 val _ = hasChanged := true 118 (* Put in a replacement so that if we were previously testing ccRefOut 119 we should instead test ccRef. *) 120 val repl = 121 BRSetConditionToConstant{srcCC=ccRefOut, signedCompare=LargeInt.compare(test, arg2), 122 (* Unsigned tests. We converted the values from Word to LargeInt. We can therefore 123 turn the tests back to Word for the unsigned comparisons. *) 124 unsignedCompare=Word.compare(Word.fromLargeInt test, Word.fromLargeInt arg2)} 125 val _ = isSome outCCState andalso raise InternalError "optCode: CC exported" 126 in 127 optCode(rest, repl, memRefsOut, code) 128 end 129 130 | repArg1 => 131 optCode(rest, BRNone, memRefsOut, 132 CompareLiteral{arg1=repArg1, arg2=arg2, ccRef=ccRefOut, opSize=opSize}::code) 133 end 134 135 | optCode({instr=LoadArgument{dest, source, kind=Move64Bit}, kill, ...} :: rest, inCond, regMap, code) = 136 let 137 val (repSource, mapAfterReplace) = replaceWithValue(source, kill, regMap, OpSize64) 138 (* If the value is a constant or memory after replacement we include this. *) 139 val mapOut = 140 if (case repSource of MemoryLocation _ => true | IntegerConstant _ => true | _ => false) 141 then {dest=dest, source=repSource, opSize=OpSize64} :: mapAfterReplace 142 else mapAfterReplace 143 val outInstr = LoadArgument{dest=dest, source=repSource, kind=Move64Bit} 144 in 145 optCode(rest, inCond, mapOut, outInstr::code) 146 end 147 148 | optCode({instr=LoadArgument{dest, source, kind=Move32Bit}, kill, ...} :: rest, inCond, regMap, code) = 149 let 150 val (repSource, mapAfterReplace) = replaceWithValue(source, kill, regMap, OpSize32) 151 val mapOut = 152 if (case repSource of MemoryLocation _ => true | IntegerConstant _ => true | _ => false) 153 then {dest=dest, source=repSource, opSize=OpSize32} :: mapAfterReplace 154 else mapAfterReplace 155 val outInstr = LoadArgument{dest=dest, source=repSource, kind=Move32Bit} 156 in 157 optCode(rest, inCond, mapOut, outInstr::code) 158 end 159 160 | optCode({instr as LoadArgument{dest, source as MemoryLocation _, kind} , ...} :: rest, inCond, regMap, code) = 161 let 162 (* If we load a memory location add it to the list in case we can use it later. *) 163 val memRefsOut = 164 case kind of 165 Move64Bit => {dest=dest, source=source, opSize=OpSize64} :: regMap 166 | Move32Bit => {dest=dest, source=source, opSize=OpSize32} :: regMap 167 | _ => regMap 168 in 169 optCode(rest, inCond, memRefsOut, instr::code) 170 end 171 172 | optCode({instr as StoreArgument _, ...} :: rest, inCond, _, code) = 173 (* This may change a value in memory. For safety remove everything. *) 174 optCode(rest, inCond, [], instr::code) 175 176 | optCode({instr as FunctionCall _, ...} :: rest, _, _, code) = 177 optCode(rest, BRNone, [], instr::code) 178 179 | optCode({instr as BeginLoop, ...} :: rest, _, _, code) = 180 (* Any register value from outside the loop are not valid inside. *) 181 optCode(rest, BRNone, [], instr::code) 182 183 | optCode({instr as JumpLoop _, ...} :: rest, _, _, code) = 184 (* Likewise at the end of the loop. Not sure if this is essential. *) 185 optCode(rest, BRNone, [], instr::code) 186 187 (* These instructions could take memory operands. This isn't the full set but the others are 188 rare or only take memory operands that refer to boxed memory. *) 189 | optCode({instr=WordComparison{arg1, arg2, ccRef, opSize}, kill, ...} :: rest, _, regMap, code) = 190 let 191 (* Replace register reference with memory if possible. *) 192 val (source, memRefsOut) = replaceWithValue(arg2, kill, regMap, opSize) 193 in 194 (* This affects the CC. *) 195 optCode(rest, BRNone, memRefsOut, WordComparison{arg1=arg1, arg2=source, ccRef=ccRef, opSize=opSize}::code) 196 end 197 198 | optCode({instr=ArithmeticFunction{oper, resultReg, operand1, operand2, ccRef, opSize}, kill, ...} :: rest, _, regMap, code) = 199 let 200 (* Replace register reference with memory if possible. *) 201 val (source, memRefsOut) = replaceWithValue(operand2, kill, regMap, opSize) 202 in 203 (* This affects the CC. *) 204 optCode(rest, BRNone, memRefsOut, 205 ArithmeticFunction{oper=oper, resultReg=resultReg, operand1=operand1, 206 operand2=source, ccRef=ccRef, opSize=opSize}::code) 207 end 208 209 | optCode({instr as TestTagBit{arg, ccRef}, kill, ...} :: rest, _, regMap, code) = 210 let 211 (* Replace register reference with memory. In some circumstances it can try to 212 replace it with a constant. Since we don't code-generate that case we 213 need to filter it out and retain the original register. *) 214 val (source, memRefsOut) = replaceWithValue(arg, kill, regMap, polyWordOpSize) 215 val resultInstr = 216 case source of 217 IntegerConstant _ => instr (* Use original *) 218 | AddressConstant _ => instr 219 | _ => TestTagBit{arg=source, ccRef=ccRef} 220 in 221 (* This affects the CC. *) 222 optCode(rest, BRNone, memRefsOut, resultInstr::code) 223 end 224 225 | optCode({instr=UntagFloat{source, dest, cache=_}, kill, ...} :: rest, _, regMap, code) = 226 let 227 (* Replace register reference with memory if possible. *) 228 val (source, memRefsOut) = replaceWithValue(source, kill, regMap, polyWordOpSize) 229 in 230 (* Not sure if this affects the CC but assume it might. *) 231 optCode(rest, BRNone, memRefsOut, UntagFloat{source=source, dest=dest, cache=NONE}::code) 232 end 233 234 | optCode({instr, ...} :: rest, inCond, regMap, code) = 235 let 236 (* If this instruction affects the CC the cached SetToCondition will no longer be valid. *) 237 val afterCond = 238 case getInstructionCC instr of 239 CCUnchanged => inCond 240 | _ => BRNone 241 in 242 optCode(rest, afterCond, regMap, instr::code) 243 end 244 245 val (blkCode, finalRepl, finalMap) = optCode(block, BRNone, [], processed) 246 in 247 case (flow, finalRepl) of 248 (* We have a Condition and a change to the condition. *) 249 (flow as Conditional{ccRef, condition, trueJump, falseJump}, 250 BRSetConditionToConstant({srcCC, signedCompare, unsignedCompare, ...})) => 251 if srcCC = ccRef 252 then 253 let 254 val testResult = 255 case (condition, signedCompare, unsignedCompare) of 256 (JE, EQUAL, _) => true 257 | (JE, _, _) => false 258 | (JNE, EQUAL, _) => false 259 | (JNE, _, _) => true 260 | (JL, LESS, _) => true 261 | (JL, _, _) => false 262 | (JG, GREATER,_) => true 263 | (JG, _, _) => false 264 | (JLE, GREATER,_) => false 265 | (JLE, _, _) => true 266 | (JGE, LESS, _) => false 267 | (JGE, _, _) => true 268 | (JB, _, LESS ) => true 269 | (JB, _, _) => false 270 | (JA, _,GREATER) => true 271 | (JA, _, _) => false 272 | (JNA, _,GREATER) => false 273 | (JNA, _, _) => true 274 | (JNB, _, LESS ) => false 275 | (JNB, _, _) => true 276 (* The overflow and parity checks should never occur. *) 277 | _ => raise InternalError "getCondResult: comparison" 278 279 val newFlow = 280 if testResult 281 then Unconditional trueJump 282 else Unconditional falseJump 283 284 val() = hasChanged := true 285 in 286 BasicBlock{flow=newFlow, block=List.rev blkCode} 287 end 288 else BasicBlock{flow=flow, block=List.rev blkCode} 289 290 | (flow as Unconditional jmp, _) => 291 let 292 val ExtendedBasicBlock{block=targetBlck, locals, exports, flow=targetFlow, outCCState=targetCC, ...} = 293 Vector.sub(code, jmp) 294 (* If the target is empty or is simply one or more Resets or a Return we're 295 better off merging this in rather than doing the jump. We allow a single 296 Load e.g. when loading a constant or moving a register. 297 If we have a CompareLiteral and we're comparing with a register in the map 298 that has been set to a constant we include that because the comparison will 299 then be reduced to a constant. *) 300 fun isSimple([], _, _) = true 301 | isSimple ({instr=ResetStackPtr _, ...} :: instrs, moves, regMap) = isSimple(instrs, moves, regMap) 302 | isSimple ({instr=ReturnResultFromFunction _, ...} :: instrs, moves, regMap) = isSimple(instrs, moves, regMap) 303 | isSimple ({instr=RaiseExceptionPacket _, ...} :: instrs, moves, regMap) = isSimple(instrs, moves, regMap) 304 | isSimple ({instr=LoadArgument{source=RegisterArgument preg, dest, kind=Move64Bit}, ...} :: instrs, moves, regMap) = 305 let 306 (* We frequently have a move of the original register into a new register before the test. *) 307 val newMap = 308 case List.find(fn {dest, ... } => dest = preg) regMap of 309 SOME {source, ...} => {dest=dest, source=source, opSize=OpSize64} :: regMap 310 | NONE => regMap 311 in 312 moves = 0 andalso isSimple(instrs, moves+1, newMap) 313 end 314 | isSimple ({instr=LoadArgument{source=RegisterArgument preg, dest, kind=Move32Bit}, ...} :: instrs, moves, regMap) = 315 let 316 (* We frequently have a move of the original register into a new register before the test. *) 317 val newMap = 318 case List.find(fn {dest, ... } => dest = preg) regMap of 319 SOME {source, ...} => {dest=dest, source=source, opSize=OpSize32} :: regMap 320 | NONE => regMap 321 in 322 moves = 0 andalso isSimple(instrs, moves+1, newMap) 323 end 324 | isSimple ({instr=LoadArgument _, ...} :: instrs, moves, regMap) = moves = 0 andalso isSimple(instrs, moves+1, regMap) 325 | isSimple ({instr=CompareLiteral{arg1=RegisterArgument preg, ...}, ...} :: instrs, moves, regMap) = 326 let 327 val isReplace = List.find(fn {dest, ... } => dest = preg) regMap 328 in 329 case isReplace of 330 SOME {source=IntegerConstant _, ...} => isSimple(instrs, moves, regMap) 331 | _ => false 332 end 333 | isSimple _ = false 334 335 in 336 (* Merge trivial blocks. This previously also tried to merge non-trivial blocks if 337 they only had one reference but this ends up duplicating non-trivial code. If we 338 have a trivial block that has multiple references but is the only reference to 339 a non-trivial block we can merge the non-trivial block into it. That would 340 be fine except that at the same time we may merge this trivial block elsewhere. *) 341 (* The restriction that a block must only export "merge" registers is unfortunate 342 but necessary to avoid the situation where a non-merge register is defined at 343 multiple points and cannot be pushed to the stack. This really isn't an issue 344 with blocks with unconditional branches but there are cases where we have 345 successive tests of the same condition and that results in local registers 346 being defined and then exported. This occurs in, for example, 347 fun f x = if x > "abcde" then "yes" else "no"; *) 348 if isSimple(targetBlck, 0, finalMap) andalso 349 List.all (fn i => Vector.sub(pregProps, i) = RegPropMultiple) (setToList exports) 350 then 351 let 352 (* Copy the block, creating new registers for the locals. *) 353 val localMap = List.map (fn r => (PReg r, newReg(Vector.sub(pregProps, r)))) (setToList locals) 354 fun mapReg r = case List.find (fn (s, _) => r = s) localMap of SOME(_, s) => s | NONE => r 355 fun mapIndex(MemIndex1 r) = MemIndex1(mapReg r) 356 | mapIndex(MemIndex2 r) = MemIndex2(mapReg r) 357 | mapIndex(MemIndex4 r) = MemIndex4(mapReg r) 358 | mapIndex(MemIndex8 r) = MemIndex8(mapReg r) 359 | mapIndex index = index 360 fun mapArg(RegisterArgument r) = RegisterArgument(mapReg r) 361 | mapArg(MemoryLocation{base, offset, index, ...}) = 362 MemoryLocation{base=mapReg base, offset=offset, index=mapIndex index, cache=NONE} 363 | mapArg arg = arg 364 fun mapInstr(instr as ResetStackPtr _) = instr 365 | mapInstr(ReturnResultFromFunction{resultReg, realReg, numStackArgs}) = 366 ReturnResultFromFunction{resultReg=mapReg resultReg, realReg=realReg, numStackArgs=numStackArgs} 367 | mapInstr(RaiseExceptionPacket{packetReg}) = 368 RaiseExceptionPacket{packetReg=mapReg packetReg} 369 | mapInstr(LoadArgument{source, dest, kind}) = 370 LoadArgument{source=mapArg source, dest=mapReg dest, kind=kind} 371 | mapInstr(CompareLiteral{arg1, arg2, opSize, ccRef}) = 372 CompareLiteral{arg1=mapArg arg1, arg2=arg2, opSize=opSize, ccRef=ccRef} 373 | mapInstr _ = raise InternalError "mapInstr: other instruction" 374 fun mapRegNo i = case(mapReg(PReg i)) of PReg r => r 375 (* Map the instructions and the sets although we only use the kill set. *) 376 fun mapCode{instr, current, active, kill} = 377 {instr=mapInstr instr, current=listToSet(map mapRegNo (setToList current)), 378 active=listToSet(map mapRegNo (setToList active)), kill=listToSet(map mapRegNo (setToList kill))} 379 in 380 hasChanged := true; 381 optimiseBlock blkCode(map mapCode targetBlck, targetFlow, targetCC) 382 end 383 else BasicBlock{flow=flow, block=List.rev blkCode} 384 end 385 386 | (flow, _) => BasicBlock{flow=flow, block=List.rev blkCode} 387 end 388 389 fun optBlck(ExtendedBasicBlock{block, flow, outCCState, ...}) = optimiseBlock [] (block, flow, outCCState) 390 val resVector = Vector.map optBlck code 391 in 392 if !hasChanged 393 then 394 let 395 val extraRegs = List.rev(! regList) 396 val props = 397 if null extraRegs 398 then pregProps 399 else Vector.concat[pregProps, Vector.fromList extraRegs] 400 in 401 Changed(resVector, props) 402 end 403 else Unchanged 404 end 405 406 structure Sharing = 407 struct 408 type extendedBasicBlock = extendedBasicBlock 409 and basicBlock = basicBlock 410 and regProperty = regProperty 411 and optimise = optimise 412 end 413end; 414