Merge branch 'master' of git://factorcode.org/git/factor
Aaron Schaefer
commit
db7002effa
|
|
@ -58,11 +58,11 @@ SYMBOL: progress
|
|||
|
||||
! Coalescing
|
||||
: active-interval ( vreg -- live-interval )
|
||||
dup active-intervals-for [ vreg>> = ] with find nip ;
|
||||
dup [ dup active-intervals-for [ vreg>> = ] with find nip ] when ;
|
||||
|
||||
: coalesce? ( live-interval -- ? )
|
||||
[ start>> ] [ copy-from>> ] bi
|
||||
dup [ active-interval end>> = ] [ 2drop f ] if ;
|
||||
[ start>> ] [ copy-from>> active-interval ] bi
|
||||
dup [ end>> = ] [ 2drop f ] if ;
|
||||
|
||||
: coalesce ( live-interval -- )
|
||||
dup copy-from>> active-interval
|
||||
|
|
|
|||
|
|
@ -355,3 +355,851 @@ USING: math.private compiler.cfg.debugger ;
|
|||
{ { int-regs { 0 1 2 3 } } }
|
||||
allocate-registers drop
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
{
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687168 }
|
||||
{ start 106 }
|
||||
{ end 112 }
|
||||
{ uses V{ 106 112 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687169 }
|
||||
{ start 107 }
|
||||
{ end 113 }
|
||||
{ uses V{ 107 113 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687727 }
|
||||
{ start 190 }
|
||||
{ end 198 }
|
||||
{ uses V{ 190 195 198 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686445 }
|
||||
{ start 43 }
|
||||
{ end 44 }
|
||||
{ uses V{ 43 44 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686195 }
|
||||
{ start 5 }
|
||||
{ end 11 }
|
||||
{ uses V{ 5 11 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686449 }
|
||||
{ start 44 }
|
||||
{ end 56 }
|
||||
{ uses V{ 44 45 45 46 56 } }
|
||||
{ copy-from V int-regs 3686445 }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686198 }
|
||||
{ start 8 }
|
||||
{ end 10 }
|
||||
{ uses V{ 8 9 10 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686454 }
|
||||
{ start 46 }
|
||||
{ end 49 }
|
||||
{ uses V{ 46 47 47 49 } }
|
||||
{ copy-from V int-regs 3686449 }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686196 }
|
||||
{ start 6 }
|
||||
{ end 12 }
|
||||
{ uses V{ 6 12 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686197 }
|
||||
{ start 7 }
|
||||
{ end 14 }
|
||||
{ uses V{ 7 13 14 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686455 }
|
||||
{ start 48 }
|
||||
{ end 51 }
|
||||
{ uses V{ 48 51 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686463 }
|
||||
{ start 52 }
|
||||
{ end 53 }
|
||||
{ uses V{ 52 53 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686460 }
|
||||
{ start 49 }
|
||||
{ end 52 }
|
||||
{ uses V{ 49 50 50 52 } }
|
||||
{ copy-from V int-regs 3686454 }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686461 }
|
||||
{ start 51 }
|
||||
{ end 71 }
|
||||
{ uses V{ 51 52 64 68 71 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686464 }
|
||||
{ start 53 }
|
||||
{ end 54 }
|
||||
{ uses V{ 53 54 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686465 }
|
||||
{ start 54 }
|
||||
{ end 76 }
|
||||
{ uses V{ 54 55 55 76 } }
|
||||
{ copy-from V int-regs 3686464 }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686470 }
|
||||
{ start 58 }
|
||||
{ end 60 }
|
||||
{ uses V{ 58 59 59 60 } }
|
||||
{ copy-from V int-regs 3686469 }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686469 }
|
||||
{ start 56 }
|
||||
{ end 58 }
|
||||
{ uses V{ 56 57 57 58 } }
|
||||
{ copy-from V int-regs 3686449 }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686473 }
|
||||
{ start 60 }
|
||||
{ end 62 }
|
||||
{ uses V{ 60 61 61 62 } }
|
||||
{ copy-from V int-regs 3686470 }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686479 }
|
||||
{ start 62 }
|
||||
{ end 64 }
|
||||
{ uses V{ 62 63 63 64 } }
|
||||
{ copy-from V int-regs 3686473 }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686735 }
|
||||
{ start 78 }
|
||||
{ end 96 }
|
||||
{ uses V{ 78 79 79 96 } }
|
||||
{ copy-from V int-regs 3686372 }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686482 }
|
||||
{ start 64 }
|
||||
{ end 65 }
|
||||
{ uses V{ 64 65 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686483 }
|
||||
{ start 65 }
|
||||
{ end 66 }
|
||||
{ uses V{ 65 66 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687510 }
|
||||
{ start 168 }
|
||||
{ end 171 }
|
||||
{ uses V{ 168 171 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687511 }
|
||||
{ start 169 }
|
||||
{ end 176 }
|
||||
{ uses V{ 169 176 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686484 }
|
||||
{ start 66 }
|
||||
{ end 75 }
|
||||
{ uses V{ 66 67 67 75 } }
|
||||
{ copy-from V int-regs 3686483 }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687509 }
|
||||
{ start 162 }
|
||||
{ end 163 }
|
||||
{ uses V{ 162 163 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686491 }
|
||||
{ start 68 }
|
||||
{ end 69 }
|
||||
{ uses V{ 68 69 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687512 }
|
||||
{ start 170 }
|
||||
{ end 178 }
|
||||
{ uses V{ 170 177 178 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687515 }
|
||||
{ start 172 }
|
||||
{ end 173 }
|
||||
{ uses V{ 172 173 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686492 }
|
||||
{ start 69 }
|
||||
{ end 74 }
|
||||
{ uses V{ 69 70 70 74 } }
|
||||
{ copy-from V int-regs 3686491 }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687778 }
|
||||
{ start 202 }
|
||||
{ end 208 }
|
||||
{ uses V{ 202 208 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686499 }
|
||||
{ start 71 }
|
||||
{ end 72 }
|
||||
{ uses V{ 71 72 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687520 }
|
||||
{ start 174 }
|
||||
{ end 175 }
|
||||
{ uses V{ 174 175 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687779 }
|
||||
{ start 203 }
|
||||
{ end 209 }
|
||||
{ uses V{ 203 209 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687782 }
|
||||
{ start 206 }
|
||||
{ end 207 }
|
||||
{ uses V{ 206 207 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686503 }
|
||||
{ start 74 }
|
||||
{ end 75 }
|
||||
{ uses V{ 74 75 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686500 }
|
||||
{ start 72 }
|
||||
{ end 74 }
|
||||
{ uses V{ 72 73 73 74 } }
|
||||
{ copy-from V int-regs 3686499 }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687780 }
|
||||
{ start 204 }
|
||||
{ end 210 }
|
||||
{ uses V{ 204 210 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686506 }
|
||||
{ start 75 }
|
||||
{ end 76 }
|
||||
{ uses V{ 75 76 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687530 }
|
||||
{ start 185 }
|
||||
{ end 192 }
|
||||
{ uses V{ 185 192 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687528 }
|
||||
{ start 183 }
|
||||
{ end 198 }
|
||||
{ uses V{ 183 198 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687529 }
|
||||
{ start 184 }
|
||||
{ end 197 }
|
||||
{ uses V{ 184 197 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687781 }
|
||||
{ start 205 }
|
||||
{ end 211 }
|
||||
{ uses V{ 205 211 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687535 }
|
||||
{ start 187 }
|
||||
{ end 194 }
|
||||
{ uses V{ 187 194 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686252 }
|
||||
{ start 9 }
|
||||
{ end 17 }
|
||||
{ uses V{ 9 15 17 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686509 }
|
||||
{ start 76 }
|
||||
{ end 90 }
|
||||
{ uses V{ 76 87 90 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687532 }
|
||||
{ start 186 }
|
||||
{ end 196 }
|
||||
{ uses V{ 186 196 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687538 }
|
||||
{ start 188 }
|
||||
{ end 193 }
|
||||
{ uses V{ 188 193 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687827 }
|
||||
{ start 217 }
|
||||
{ end 219 }
|
||||
{ uses V{ 217 219 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687825 }
|
||||
{ start 215 }
|
||||
{ end 218 }
|
||||
{ uses V{ 215 216 218 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687831 }
|
||||
{ start 218 }
|
||||
{ end 219 }
|
||||
{ uses V{ 218 219 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686296 }
|
||||
{ start 16 }
|
||||
{ end 18 }
|
||||
{ uses V{ 16 18 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686302 }
|
||||
{ start 29 }
|
||||
{ end 31 }
|
||||
{ uses V{ 29 31 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687838 }
|
||||
{ start 231 }
|
||||
{ end 232 }
|
||||
{ uses V{ 231 232 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686300 }
|
||||
{ start 26 }
|
||||
{ end 27 }
|
||||
{ uses V{ 26 27 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686301 }
|
||||
{ start 27 }
|
||||
{ end 30 }
|
||||
{ uses V{ 27 28 28 30 } }
|
||||
{ copy-from V int-regs 3686300 }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686306 }
|
||||
{ start 37 }
|
||||
{ end 93 }
|
||||
{ uses V{ 37 82 93 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686307 }
|
||||
{ start 38 }
|
||||
{ end 88 }
|
||||
{ uses V{ 38 85 88 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687837 }
|
||||
{ start 222 }
|
||||
{ end 223 }
|
||||
{ uses V{ 222 223 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686305 }
|
||||
{ start 36 }
|
||||
{ end 81 }
|
||||
{ uses V{ 36 42 77 81 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686310 }
|
||||
{ start 39 }
|
||||
{ end 95 }
|
||||
{ uses V{ 39 84 95 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687836 }
|
||||
{ start 227 }
|
||||
{ end 228 }
|
||||
{ uses V{ 227 228 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687839 }
|
||||
{ start 239 }
|
||||
{ end 246 }
|
||||
{ uses V{ 239 245 246 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687841 }
|
||||
{ start 240 }
|
||||
{ end 241 }
|
||||
{ uses V{ 240 241 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687845 }
|
||||
{ start 241 }
|
||||
{ end 243 }
|
||||
{ uses V{ 241 243 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686315 }
|
||||
{ start 40 }
|
||||
{ end 94 }
|
||||
{ uses V{ 40 83 94 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687846 }
|
||||
{ start 242 }
|
||||
{ end 245 }
|
||||
{ uses V{ 242 245 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687849 }
|
||||
{ start 243 }
|
||||
{ end 245 }
|
||||
{ uses V{ 243 244 244 245 } }
|
||||
{ copy-from V int-regs 3687845 }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687850 }
|
||||
{ start 245 }
|
||||
{ end 245 }
|
||||
{ uses V{ 245 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687851 }
|
||||
{ start 246 }
|
||||
{ end 246 }
|
||||
{ uses V{ 246 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687852 }
|
||||
{ start 246 }
|
||||
{ end 246 }
|
||||
{ uses V{ 246 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687853 }
|
||||
{ start 247 }
|
||||
{ end 248 }
|
||||
{ uses V{ 247 248 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687854 }
|
||||
{ start 249 }
|
||||
{ end 250 }
|
||||
{ uses V{ 249 250 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687855 }
|
||||
{ start 258 }
|
||||
{ end 259 }
|
||||
{ uses V{ 258 259 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687080 }
|
||||
{ start 280 }
|
||||
{ end 285 }
|
||||
{ uses V{ 280 285 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687081 }
|
||||
{ start 281 }
|
||||
{ end 286 }
|
||||
{ uses V{ 281 286 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687082 }
|
||||
{ start 282 }
|
||||
{ end 287 }
|
||||
{ uses V{ 282 287 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687083 }
|
||||
{ start 283 }
|
||||
{ end 288 }
|
||||
{ uses V{ 283 288 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687085 }
|
||||
{ start 284 }
|
||||
{ end 299 }
|
||||
{ uses V{ 284 285 286 287 288 296 299 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687086 }
|
||||
{ start 284 }
|
||||
{ end 284 }
|
||||
{ uses V{ 284 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687087 }
|
||||
{ start 289 }
|
||||
{ end 293 }
|
||||
{ uses V{ 289 293 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687088 }
|
||||
{ start 290 }
|
||||
{ end 294 }
|
||||
{ uses V{ 290 294 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687089 }
|
||||
{ start 291 }
|
||||
{ end 297 }
|
||||
{ uses V{ 291 297 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687090 }
|
||||
{ start 292 }
|
||||
{ end 298 }
|
||||
{ uses V{ 292 298 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687363 }
|
||||
{ start 118 }
|
||||
{ end 119 }
|
||||
{ uses V{ 118 119 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686599 }
|
||||
{ start 77 }
|
||||
{ end 89 }
|
||||
{ uses V{ 77 86 89 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687370 }
|
||||
{ start 131 }
|
||||
{ end 132 }
|
||||
{ uses V{ 131 132 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687371 }
|
||||
{ start 138 }
|
||||
{ end 143 }
|
||||
{ uses V{ 138 143 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687368 }
|
||||
{ start 127 }
|
||||
{ end 128 }
|
||||
{ uses V{ 127 128 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687369 }
|
||||
{ start 122 }
|
||||
{ end 123 }
|
||||
{ uses V{ 122 123 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687373 }
|
||||
{ start 139 }
|
||||
{ end 140 }
|
||||
{ uses V{ 139 140 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686352 }
|
||||
{ start 41 }
|
||||
{ end 91 }
|
||||
{ uses V{ 41 43 79 91 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687377 }
|
||||
{ start 140 }
|
||||
{ end 141 }
|
||||
{ uses V{ 140 141 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687382 }
|
||||
{ start 143 }
|
||||
{ end 143 }
|
||||
{ uses V{ 143 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687383 }
|
||||
{ start 144 }
|
||||
{ end 161 }
|
||||
{ uses V{ 144 159 161 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687380 }
|
||||
{ start 141 }
|
||||
{ end 143 }
|
||||
{ uses V{ 141 142 142 143 } }
|
||||
{ copy-from V int-regs 3687377 }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687381 }
|
||||
{ start 143 }
|
||||
{ end 160 }
|
||||
{ uses V{ 143 160 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687384 }
|
||||
{ start 145 }
|
||||
{ end 158 }
|
||||
{ uses V{ 145 158 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687385 }
|
||||
{ start 146 }
|
||||
{ end 157 }
|
||||
{ uses V{ 146 157 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687640 }
|
||||
{ start 189 }
|
||||
{ end 191 }
|
||||
{ uses V{ 189 191 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687388 }
|
||||
{ start 147 }
|
||||
{ end 152 }
|
||||
{ uses V{ 147 152 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687393 }
|
||||
{ start 148 }
|
||||
{ end 153 }
|
||||
{ uses V{ 148 153 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687398 }
|
||||
{ start 149 }
|
||||
{ end 154 }
|
||||
{ uses V{ 149 154 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686372 }
|
||||
{ start 42 }
|
||||
{ end 92 }
|
||||
{ uses V{ 42 45 78 80 92 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687140 }
|
||||
{ start 293 }
|
||||
{ end 295 }
|
||||
{ uses V{ 293 294 294 295 } }
|
||||
{ copy-from V int-regs 3687087 }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687403 }
|
||||
{ start 150 }
|
||||
{ end 155 }
|
||||
{ uses V{ 150 155 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687150 }
|
||||
{ start 304 }
|
||||
{ end 306 }
|
||||
{ uses V{ 304 306 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687151 }
|
||||
{ start 305 }
|
||||
{ end 307 }
|
||||
{ uses V{ 305 307 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687408 }
|
||||
{ start 151 }
|
||||
{ end 156 }
|
||||
{ uses V{ 151 156 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687153 }
|
||||
{ start 312 }
|
||||
{ end 313 }
|
||||
{ uses V{ 312 313 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686902 }
|
||||
{ start 267 }
|
||||
{ end 272 }
|
||||
{ uses V{ 267 272 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686903 }
|
||||
{ start 268 }
|
||||
{ end 273 }
|
||||
{ uses V{ 268 273 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686900 }
|
||||
{ start 265 }
|
||||
{ end 270 }
|
||||
{ uses V{ 265 270 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686901 }
|
||||
{ start 266 }
|
||||
{ end 271 }
|
||||
{ uses V{ 266 271 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687162 }
|
||||
{ start 100 }
|
||||
{ end 119 }
|
||||
{ uses V{ 100 114 117 119 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687163 }
|
||||
{ start 101 }
|
||||
{ end 118 }
|
||||
{ uses V{ 101 115 116 118 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3686904 }
|
||||
{ start 269 }
|
||||
{ end 274 }
|
||||
{ uses V{ 269 274 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687166 }
|
||||
{ start 104 }
|
||||
{ end 110 }
|
||||
{ uses V{ 104 110 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687167 }
|
||||
{ start 105 }
|
||||
{ end 111 }
|
||||
{ uses V{ 105 111 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687164 }
|
||||
{ start 102 }
|
||||
{ end 108 }
|
||||
{ uses V{ 102 108 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 3687165 }
|
||||
{ start 103 }
|
||||
{ end 109 }
|
||||
{ uses V{ 103 109 } }
|
||||
}
|
||||
}
|
||||
{ { int-regs { 0 1 2 3 4 } } }
|
||||
allocate-registers drop
|
||||
] unit-test
|
||||
|
||||
! A reduction of the above
|
||||
[ ] [
|
||||
{
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 6449 }
|
||||
{ start 44 }
|
||||
{ end 56 }
|
||||
{ uses V{ 44 45 46 56 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 6454 }
|
||||
{ start 46 }
|
||||
{ end 49 }
|
||||
{ uses V{ 46 47 49 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 6455 }
|
||||
{ start 48 }
|
||||
{ end 51 }
|
||||
{ uses V{ 48 51 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 6460 }
|
||||
{ start 49 }
|
||||
{ end 52 }
|
||||
{ uses V{ 49 50 52 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 6461 }
|
||||
{ start 51 }
|
||||
{ end 71 }
|
||||
{ uses V{ 51 52 64 68 71 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 6464 }
|
||||
{ start 53 }
|
||||
{ end 54 }
|
||||
{ uses V{ 53 54 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 6470 }
|
||||
{ start 58 }
|
||||
{ end 60 }
|
||||
{ uses V{ 58 59 60 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 6469 }
|
||||
{ start 56 }
|
||||
{ end 58 }
|
||||
{ uses V{ 56 57 58 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 6473 }
|
||||
{ start 60 }
|
||||
{ end 62 }
|
||||
{ uses V{ 60 61 62 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 6479 }
|
||||
{ start 62 }
|
||||
{ end 64 }
|
||||
{ uses V{ 62 63 64 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 6735 }
|
||||
{ start 78 }
|
||||
{ end 96 }
|
||||
{ uses V{ 78 79 96 } }
|
||||
{ copy-from V int-regs 6372 }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 6483 }
|
||||
{ start 65 }
|
||||
{ end 66 }
|
||||
{ uses V{ 65 66 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 7845 }
|
||||
{ start 91 }
|
||||
{ end 93 }
|
||||
{ uses V{ 91 93 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg V int-regs 6372 }
|
||||
{ start 42 }
|
||||
{ end 92 }
|
||||
{ uses V{ 42 45 78 80 92 } }
|
||||
}
|
||||
}
|
||||
{ { int-regs { 0 1 2 3 } } }
|
||||
allocate-registers drop
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -20,16 +20,17 @@ M: insn linearize-insn , drop ;
|
|||
#! don't need to branch.
|
||||
[ number>> ] bi@ 1- = ; inline
|
||||
|
||||
: branch-to-return? ( successor -- ? )
|
||||
#! A branch to a block containing just a return is cloned.
|
||||
: branch-to-branch? ( successor -- ? )
|
||||
#! A branch to a block containing just a jump return is cloned.
|
||||
instructions>> dup length 2 = [
|
||||
[ first ##epilogue? ] [ second ##return? ] bi and
|
||||
[ first ##epilogue? ]
|
||||
[ second [ ##return? ] [ ##jump? ] bi or ] bi and
|
||||
] [ drop f ] if ;
|
||||
|
||||
: emit-branch ( basic-block successor -- )
|
||||
{
|
||||
{ [ 2dup useless-branch? ] [ 2drop ] }
|
||||
{ [ dup branch-to-return? ] [ nip linearize-insns ] }
|
||||
{ [ dup branch-to-branch? ] [ nip linearize-insns ] }
|
||||
[ nip number>> _branch ]
|
||||
} cond ;
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,26 @@
|
|||
! Calling the compiler at parse time and having it compile
|
||||
! generic words defined in the current compilation unit would
|
||||
! fail. This is a regression from the 'remake-generic'
|
||||
! optimization, which would batch generic word updates at the
|
||||
! end of a compilation unit.
|
||||
|
||||
USING: kernel accessors peg.ebnf ;
|
||||
IN: compiler.tests
|
||||
|
||||
TUPLE: pipeline-expr background ;
|
||||
|
||||
GENERIC: blah ( a -- b )
|
||||
|
||||
M: pipeline-expr blah ;
|
||||
|
||||
: ast>pipeline-expr ( -- obj )
|
||||
pipeline-expr new blah ;
|
||||
|
||||
EBNF: expr
|
||||
pipeline = "hello" => [[ ast>pipeline-expr ]]
|
||||
;EBNF
|
||||
|
||||
USE: tools.test
|
||||
|
||||
[ t ] [ \ expr compiled>> ] unit-test
|
||||
[ t ] [ \ ast>pipeline-expr compiled>> ] unit-test
|
||||
|
|
@ -3,16 +3,16 @@ USING: compiler compiler.units tools.test math parser kernel
|
|||
sequences sequences.private classes.mixin generic definitions
|
||||
arrays words assocs eval ;
|
||||
|
||||
DEFER: blah
|
||||
DEFER: redefine2-test
|
||||
|
||||
[ ] [ "USE: sequences USE: kernel IN: compiler.tests TUPLE: blah ; M: blah nth 2drop 3 ; INSTANCE: blah sequence" eval ] unit-test
|
||||
[ ] [ "USE: sequences USE: kernel IN: compiler.tests TUPLE: redefine2-test ; M: redefine2-test nth 2drop 3 ; INSTANCE: redefine2-test sequence" eval ] unit-test
|
||||
|
||||
[ t ] [ blah new sequence? ] unit-test
|
||||
[ t ] [ redefine2-test new sequence? ] unit-test
|
||||
|
||||
[ 3 ] [ 0 blah new nth-unsafe ] unit-test
|
||||
[ 3 ] [ 0 redefine2-test new nth-unsafe ] unit-test
|
||||
|
||||
[ ] [ [ blah sequence remove-mixin-instance ] with-compilation-unit ] unit-test
|
||||
[ ] [ [ redefine2-test sequence remove-mixin-instance ] with-compilation-unit ] unit-test
|
||||
|
||||
[ f ] [ blah new sequence? ] unit-test
|
||||
[ f ] [ redefine2-test new sequence? ] unit-test
|
||||
|
||||
[ 0 blah new nth-unsafe ] must-fail
|
||||
[ 0 redefine2-test new nth-unsafe ] must-fail
|
||||
|
|
|
|||
|
|
@ -164,7 +164,16 @@ SYMBOL: history
|
|||
first object swap eliminate-dispatch ;
|
||||
|
||||
: do-inlining ( #call word -- ? )
|
||||
#! If the generic was defined in an outer compilation unit,
|
||||
#! then it doesn't have a definition yet; the definition
|
||||
#! is built at the end of the compilation unit. We do not
|
||||
#! attempt inlining at this stage since the stack discipline
|
||||
#! is not finalized yet, so dispatch# might return an out
|
||||
#! of bounds value. This case comes up if a parsing word
|
||||
#! calls the compiler at parse time (doing so is
|
||||
#! discouraged, but it should still work.)
|
||||
{
|
||||
{ [ dup deferred? ] [ 2drop f ] }
|
||||
{ [ dup custom-inlining? ] [ inline-custom ] }
|
||||
{ [ dup always-inline-word? ] [ inline-word ] }
|
||||
{ [ dup standard-generic? ] [ inline-standard-method ] }
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
USING: bootstrap.image.private kernel kernel.private namespaces
|
||||
system cpu.ppc.assembler compiler.codegen.fixup compiler.units
|
||||
compiler.constants math math.private layouts words words.private
|
||||
vocabs slots.private ;
|
||||
vocabs slots.private locals.backend ;
|
||||
IN: bootstrap.ppc
|
||||
|
||||
4 \ cell set
|
||||
|
|
@ -305,4 +305,45 @@ big-endian on
|
|||
3 ds-reg 0 STW
|
||||
] f f f \ fixnum-bitnot define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
3 3 tag-bits get SRAWI
|
||||
ds-reg ds-reg 4 SUBI
|
||||
4 ds-reg 0 LWZ
|
||||
5 4 3 SLW
|
||||
6 3 NEG
|
||||
7 4 6 SRAW
|
||||
7 7 0 0 31 tag-bits get - RLWINM
|
||||
0 3 0 CMPI
|
||||
2 BGT
|
||||
5 7 MR
|
||||
5 ds-reg 0 STW
|
||||
] f f f \ fixnum-shift-fast define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
ds-reg ds-reg 4 SUBI
|
||||
4 ds-reg 0 LWZ
|
||||
5 4 3 DIVW
|
||||
6 5 3 MULLW
|
||||
7 6 4 SUBF
|
||||
7 ds-reg 0 STW
|
||||
] f f f \ fixnum-mod define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
3 3 1 SRAWI
|
||||
4 4 LI
|
||||
4 3 4 SUBF
|
||||
rs-reg 3 4 LWZX
|
||||
3 ds-reg 0 STW
|
||||
] f f f \ get-local define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
ds-reg ds-reg 4 SUBI
|
||||
3 3 1 SRAWI
|
||||
rs-reg 3 rs-reg SUBF
|
||||
] f f f \ drop-locals define-sub-primitive
|
||||
|
||||
[ "bootstrap.ppc" forget-vocab ] with-compilation-unit
|
||||
|
|
|
|||
|
|
@ -4,7 +4,8 @@ prettyprint.backend kernel.private io generic math system
|
|||
strings sbufs vectors byte-arrays quotations
|
||||
io.streams.byte-array classes.builtin parser lexer
|
||||
classes.predicate classes.union classes.intersection
|
||||
classes.singleton classes.tuple tools.vocabs.browser ;
|
||||
classes.singleton classes.tuple tools.vocabs.browser math.parser
|
||||
accessors ;
|
||||
IN: help.handbook
|
||||
|
||||
ARTICLE: "conventions" "Conventions"
|
||||
|
|
@ -26,12 +27,14 @@ $nl
|
|||
{ { $snippet { $emphasis "foo" } "?" } "outputs a boolean" { { $link empty? } } }
|
||||
{ { $snippet "?" { $emphasis "foo" } } { "conditionally performs " { $snippet { $emphasis "foo" } } } { { $links ?nth } } }
|
||||
{ { $snippet "<" { $emphasis "foo" } ">" } { "creates a new " { $snippet "foo" } } { { $link <array> } } }
|
||||
{ { $snippet ">" { $emphasis "foo" } } { "converts the top of the stack into a " { $snippet "foo" } } { { $link >array } } }
|
||||
{ { $snippet { $emphasis "foo" } ">" { $emphasis "bar" } } { "converts a " { $snippet "foo" } " into a " { $snippet "bar" } } { { $link number>string } } }
|
||||
{ { $snippet "new-" { $emphasis "foo" } } { "creates a new " { $snippet "foo" } ", taking some kind of parameter from the stack which determines the type of the object to be created" } { { $link new-sequence } ", " { $link new-lexer } ", " { $link new } } }
|
||||
{ { $snippet { $emphasis "foo" } "*" } { "alternative form of " { $snippet "foo" } ", or a generic word called by " { $snippet "foo" } } { { $links at* pprint* } } }
|
||||
{ { $snippet "(" { $emphasis "foo" } ")" } { "implementation detail word used by " { $snippet "foo" } } { { $link (clone) } } }
|
||||
{ { $snippet "set-" { $emphasis "foo" } } { "sets " { $snippet "foo" } " to a new value" } { $links set-length } }
|
||||
{ { $snippet { $emphasis "foo" } "-" { $emphasis "bar" } } { "(tuple accessors) outputs the value of the " { $snippet "bar" } " slot of the " { $snippet "foo" } " at the top of the stack" } { } }
|
||||
{ { $snippet "set-" { $emphasis "foo" } "-" { $emphasis "bar" } } { "(tuple mutators) sets the value of the " { $snippet "bar" } " slot of the " { $snippet "foo" } " at the top of the stack" } { } }
|
||||
{ { $snippet { $emphasis "foo" } ">>" } { "gets the " { $snippet "foo" } " slot of the tuple at the top of the stack; see " { $link "accessors" } } { { $link >>name } } }
|
||||
{ { $snippet ">>" { $emphasis "foo" } } { "sets the " { $snippet "foo" } " slot of the tuple at the top of the stack; see " { $link "accessors" } } { { $link name>> } } }
|
||||
{ { $snippet "with-" { $emphasis "foo" } } { "performs some kind of initialization and cleanup related to " { $snippet "foo" } ", usually in a new dynamic scope" } { $links with-scope with-input-stream with-output-stream } }
|
||||
{ { $snippet "$" { $emphasis "foo" } } { "help markup" } { $links $heading $emphasis } }
|
||||
}
|
||||
|
|
|
|||
|
|
@ -256,6 +256,7 @@ IN: tools.deploy.shaker
|
|||
compiled-generic-crossref
|
||||
recompile-hook
|
||||
update-tuples-hook
|
||||
remake-generics-hook
|
||||
definition-observers
|
||||
definitions:crossref
|
||||
interactive-vocabs
|
||||
|
|
|
|||
|
|
@ -55,7 +55,7 @@ DEFER: (class-or)
|
|||
class-or-cache get [ (class-or) ] 2cache ;
|
||||
|
||||
: superclass<= ( first second -- ? )
|
||||
>r superclass r> class<= ;
|
||||
swap superclass dup [ swap class<= ] [ 2drop f ] if ;
|
||||
|
||||
: left-anonymous-union<= ( first second -- ? )
|
||||
>r members>> r> [ class<= ] curry all? ;
|
||||
|
|
@ -103,19 +103,20 @@ PREDICATE: empty-intersection < anonymous-intersection participants>> empty? ;
|
|||
|
||||
: (class<=) ( first second -- -1/0/1 )
|
||||
2dup eq? [ 2drop t ] [
|
||||
[ normalize-class ] bi@ {
|
||||
{ [ dup empty-intersection? ] [ 2drop t ] }
|
||||
{ [ over empty-union? ] [ 2drop t ] }
|
||||
{ [ 2dup [ anonymous-complement? ] both? ] [ anonymous-complement<= ] }
|
||||
{ [ over anonymous-union? ] [ left-anonymous-union<= ] }
|
||||
{ [ over anonymous-intersection? ] [ left-anonymous-intersection<= ] }
|
||||
{ [ over nontrivial-anonymous-complement? ] [ left-anonymous-complement<= ] }
|
||||
{ [ dup anonymous-union? ] [ right-anonymous-union<= ] }
|
||||
{ [ dup anonymous-intersection? ] [ right-anonymous-intersection<= ] }
|
||||
{ [ dup anonymous-complement? ] [ class>> classes-intersect? not ] }
|
||||
{ [ over superclass ] [ superclass<= ] }
|
||||
[ 2drop f ]
|
||||
} cond
|
||||
2dup superclass<= [ 2drop t ] [
|
||||
[ normalize-class ] bi@ {
|
||||
{ [ dup empty-intersection? ] [ 2drop t ] }
|
||||
{ [ over empty-union? ] [ 2drop t ] }
|
||||
{ [ 2dup [ anonymous-complement? ] both? ] [ anonymous-complement<= ] }
|
||||
{ [ over anonymous-union? ] [ left-anonymous-union<= ] }
|
||||
{ [ over anonymous-intersection? ] [ left-anonymous-intersection<= ] }
|
||||
{ [ over nontrivial-anonymous-complement? ] [ left-anonymous-complement<= ] }
|
||||
{ [ dup anonymous-union? ] [ right-anonymous-union<= ] }
|
||||
{ [ dup anonymous-intersection? ] [ right-anonymous-intersection<= ] }
|
||||
{ [ dup anonymous-complement? ] [ class>> classes-intersect? not ] }
|
||||
[ 2drop f ]
|
||||
} cond
|
||||
] if
|
||||
] if ;
|
||||
|
||||
M: anonymous-union (classes-intersect?)
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
USING: alien arrays definitions generic assocs hashtables io
|
||||
kernel math namespaces parser prettyprint sequences strings
|
||||
tools.test vectors words quotations classes
|
||||
io.streams.string kernel math namespaces parser prettyprint
|
||||
sequences strings tools.test vectors words quotations classes
|
||||
classes.private classes.union classes.mixin classes.predicate
|
||||
classes.algebra vectors definitions source-files
|
||||
compiler.units kernel.private sorting vocabs ;
|
||||
classes.algebra vectors definitions source-files compiler.units
|
||||
kernel.private sorting vocabs memory eval accessors ;
|
||||
IN: classes.tests
|
||||
|
||||
[ t ] [ 3 object instance? ] unit-test
|
||||
|
|
@ -27,3 +27,55 @@ M: method-forget-class method-forget-test ;
|
|||
implementors-map get keys
|
||||
[ natural-sort ] bi@ =
|
||||
] unit-test
|
||||
|
||||
! Minor leak
|
||||
[ ] [ "IN: classes.tests TUPLE: forget-me ;" eval ] unit-test
|
||||
[ ] [ f \ word set-global ] unit-test
|
||||
[ ] [ "IN: classes.tests USE: kernel USE: classes.algebra forget-me tuple class<= drop" eval ] unit-test
|
||||
[ ] [ "IN: classes.tests FORGET: forget-me" eval ] unit-test
|
||||
[ 0 ] [
|
||||
[ word? ] instances
|
||||
[ [ name>> "forget-me" = ] [ vocabulary>> "classes.tests" = ] bi and ] count
|
||||
] unit-test
|
||||
|
||||
! Long-standing problem
|
||||
USE: multiline
|
||||
|
||||
! So the user has some code...
|
||||
[ ] [
|
||||
<" IN: classes.test.a
|
||||
GENERIC: g ( a -- b )
|
||||
TUPLE: x ;
|
||||
M: x g ;
|
||||
TUPLE: z < x ;"> <string-reader>
|
||||
"class-intersect-no-method-a" parse-stream drop
|
||||
] unit-test
|
||||
|
||||
! Note that q inlines M: x g ;
|
||||
[ ] [
|
||||
<" IN: classes.test.b
|
||||
USE: classes.test.a
|
||||
USE: kernel
|
||||
: q ( -- b ) z new g ;"> <string-reader>
|
||||
"class-intersect-no-method-b" parse-stream drop
|
||||
] unit-test
|
||||
|
||||
! Now, the user removes the z class and adds a method,
|
||||
[ ] [
|
||||
<" IN: classes.test.a
|
||||
GENERIC: g ( a -- b )
|
||||
TUPLE: x ;
|
||||
M: x g ;
|
||||
TUPLE: j ;
|
||||
M: j g ;"> <string-reader>
|
||||
"class-intersect-no-method-a" parse-stream drop
|
||||
] unit-test
|
||||
|
||||
! And changes the definition of q
|
||||
[ ] [
|
||||
<" IN: classes.test.b
|
||||
USE: classes.test.a
|
||||
USE: kernel
|
||||
: q ( -- b ) j new g ;"> <string-reader>
|
||||
"class-intersect-no-method-b" parse-stream drop
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -176,7 +176,8 @@ GENERIC: class-forgotten ( use class -- )
|
|||
[ implementors-map- ]
|
||||
[ update-map- ]
|
||||
[ reset-class ]
|
||||
} cleave ;
|
||||
} cleave
|
||||
reset-caches ;
|
||||
|
||||
M: class class-forgotten
|
||||
nip forget-class ;
|
||||
|
|
|
|||
|
|
@ -1,9 +1,16 @@
|
|||
USING: math tools.test ;
|
||||
USING: math tools.test classes.algebra ;
|
||||
IN: classes.predicate
|
||||
|
||||
PREDICATE: negative < integer 0 < ;
|
||||
PREDICATE: positive < integer 0 > ;
|
||||
|
||||
[ t ] [ negative integer class< ] unit-test
|
||||
[ t ] [ positive integer class< ] unit-test
|
||||
[ f ] [ integer negative class< ] unit-test
|
||||
[ f ] [ integer positive class< ] unit-test
|
||||
[ f ] [ negative negative class< ] unit-test
|
||||
[ f ] [ positive negative class< ] unit-test
|
||||
|
||||
GENERIC: abs ( n -- n )
|
||||
M: integer abs ;
|
||||
M: negative abs -1 * ;
|
||||
|
|
|
|||
|
|
@ -109,3 +109,36 @@ TUPLE: parsing-corner-case x ;
|
|||
"}"
|
||||
} "\n" join eval
|
||||
] unit-test
|
||||
|
||||
[ T{ parsing-corner-case f 3 } ] [
|
||||
{
|
||||
"USE: classes.tuple.parser.tests"
|
||||
"T{ parsing-corner-case"
|
||||
" { x 3 }"
|
||||
"}"
|
||||
} "\n" join eval
|
||||
] unit-test
|
||||
|
||||
[ T{ parsing-corner-case f 3 } ] [
|
||||
{
|
||||
"USE: classes.tuple.parser.tests"
|
||||
"T{ parsing-corner-case {"
|
||||
" x 3 }"
|
||||
"}"
|
||||
} "\n" join eval
|
||||
] unit-test
|
||||
|
||||
|
||||
[
|
||||
{
|
||||
"USE: classes.tuple.parser.tests T{ parsing-corner-case"
|
||||
" { x 3 }"
|
||||
} "\n" join eval
|
||||
] [ error>> unexpected-eof? ] must-fail-with
|
||||
|
||||
[
|
||||
{
|
||||
"USE: classes.tuple.parser.tests T{ parsing-corner-case {"
|
||||
" x 3 }"
|
||||
} "\n" join eval
|
||||
] [ error>> unexpected-eof? ] must-fail-with
|
||||
|
|
|
|||
|
|
@ -60,14 +60,19 @@ ERROR: invalid-slot-name name ;
|
|||
dup check-duplicate-slots
|
||||
3dup check-slot-shadowing ;
|
||||
|
||||
: parse-slot-value ( -- )
|
||||
scan scan-object 2array , scan "}" assert= ;
|
||||
|
||||
ERROR: bad-literal-tuple ;
|
||||
|
||||
: parse-slot-value ( -- )
|
||||
scan scan-object 2array , scan {
|
||||
{ f [ unexpected-eof ] }
|
||||
{ "}" [ ] }
|
||||
[ bad-literal-tuple ]
|
||||
} case ;
|
||||
|
||||
: (parse-slot-values) ( -- )
|
||||
parse-slot-value
|
||||
scan {
|
||||
{ f [ unexpected-eof ] }
|
||||
{ "{" [ (parse-slot-values) ] }
|
||||
{ "}" [ ] }
|
||||
[ bad-literal-tuple ]
|
||||
|
|
|
|||
|
|
@ -109,10 +109,11 @@ SYMBOL: remake-generics-hook
|
|||
compiled-generic-crossref get at ;
|
||||
|
||||
: (compiled-generic-usages) ( generic class -- assoc )
|
||||
dup class? [
|
||||
[ compiled-generic-usage ] dip
|
||||
[ classes-intersect? nip ] curry assoc-filter
|
||||
] [ 2drop f ] if ;
|
||||
[ compiled-generic-usage ] dip
|
||||
[
|
||||
2dup [ class? ] both?
|
||||
[ classes-intersect? ] [ 2drop f ] if nip
|
||||
] curry assoc-filter ;
|
||||
|
||||
: compiled-generic-usages ( assoc -- assocs )
|
||||
[ (compiled-generic-usages) ] { } assoc>map ;
|
||||
|
|
|
|||
|
|
@ -1,16 +0,0 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel words sequences lexer parser fry ;
|
||||
IN: cpu.x86.syntax
|
||||
|
||||
: define-register ( name num size -- )
|
||||
[ "cpu.x86" create dup define-symbol ]
|
||||
[ dupd "register" set-word-prop ]
|
||||
[ "register-size" set-word-prop ]
|
||||
tri* ;
|
||||
|
||||
: define-registers ( names size -- )
|
||||
[ dup length ] dip '[ _ define-register ] 2each ;
|
||||
|
||||
: REGISTERS: ( -- )
|
||||
scan-word ";" parse-tokens swap define-registers ; parsing
|
||||
|
|
@ -1 +0,0 @@
|
|||
unportable
|
||||
|
|
@ -1,470 +0,0 @@
|
|||
! Copyright (C) 2005, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays compiler.constants compiler.backend
|
||||
compiler.codegen.fixup io.binary kernel combinators
|
||||
kernel.private math namespaces make sequences words system
|
||||
layouts math.order accessors cpu.x86.syntax ;
|
||||
IN: cpu.x86
|
||||
|
||||
! A postfix assembler for x86 and AMD64.
|
||||
|
||||
! In 32-bit mode, { 1234 } is absolute indirect addressing.
|
||||
! In 64-bit mode, { 1234 } is RIP-relative.
|
||||
! Beware!
|
||||
|
||||
! Register operands -- eg, ECX
|
||||
REGISTERS: 8 AL CL DL BL ;
|
||||
|
||||
REGISTERS: 16 AX CX DX BX SP BP SI DI ;
|
||||
|
||||
REGISTERS: 32 EAX ECX EDX EBX ESP EBP ESI EDI ;
|
||||
|
||||
REGISTERS: 64
|
||||
RAX RCX RDX RBX RSP RBP RSI RDI R8 R9 R10 R11 R12 R13 R14 R15 ;
|
||||
|
||||
REGISTERS: 128
|
||||
XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7
|
||||
XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15 ;
|
||||
|
||||
TUPLE: byte value ;
|
||||
|
||||
C: <byte> byte
|
||||
|
||||
<PRIVATE
|
||||
|
||||
#! Extended AMD64 registers (R8-R15) return true.
|
||||
GENERIC: extended? ( op -- ? )
|
||||
|
||||
M: object extended? drop f ;
|
||||
|
||||
PREDICATE: register < word
|
||||
"register" word-prop ;
|
||||
|
||||
PREDICATE: register-8 < register
|
||||
"register-size" word-prop 8 = ;
|
||||
|
||||
PREDICATE: register-16 < register
|
||||
"register-size" word-prop 16 = ;
|
||||
|
||||
PREDICATE: register-32 < register
|
||||
"register-size" word-prop 32 = ;
|
||||
|
||||
PREDICATE: register-64 < register
|
||||
"register-size" word-prop 64 = ;
|
||||
|
||||
PREDICATE: register-128 < register
|
||||
"register-size" word-prop 128 = ;
|
||||
|
||||
M: register extended? "register" word-prop 7 > ;
|
||||
|
||||
! Addressing modes
|
||||
TUPLE: indirect base index scale displacement ;
|
||||
|
||||
M: indirect extended? base>> extended? ;
|
||||
|
||||
: canonicalize-EBP ( indirect -- indirect )
|
||||
#! { EBP } ==> { EBP 0 }
|
||||
dup base>> { EBP RBP R13 } member? [
|
||||
dup displacement>> [ 0 >>displacement ] unless
|
||||
] when ;
|
||||
|
||||
: canonicalize-ESP ( indirect -- indirect )
|
||||
#! { ESP } ==> { ESP ESP }
|
||||
dup base>> { ESP RSP R12 } member? [ ESP >>index ] when ;
|
||||
|
||||
: canonicalize ( indirect -- indirect )
|
||||
#! Modify the indirect to work around certain addressing mode
|
||||
#! quirks.
|
||||
canonicalize-EBP canonicalize-ESP ;
|
||||
|
||||
: <indirect> ( base index scale displacement -- indirect )
|
||||
indirect boa canonicalize ;
|
||||
|
||||
: reg-code ( reg -- n ) "register" word-prop 7 bitand ;
|
||||
|
||||
: indirect-base* ( op -- n ) base>> EBP or reg-code ;
|
||||
|
||||
: indirect-index* ( op -- n ) index>> ESP or reg-code ;
|
||||
|
||||
: indirect-scale* ( op -- n ) scale>> 0 or ;
|
||||
|
||||
GENERIC: sib-present? ( op -- ? )
|
||||
|
||||
M: indirect sib-present?
|
||||
[ base>> { ESP RSP } member? ] [ index>> ] [ scale>> ] tri or or ;
|
||||
|
||||
M: register sib-present? drop f ;
|
||||
|
||||
GENERIC: r/m ( operand -- n )
|
||||
|
||||
M: indirect r/m
|
||||
dup sib-present?
|
||||
[ drop ESP reg-code ] [ indirect-base* ] if ;
|
||||
|
||||
M: register r/m reg-code ;
|
||||
|
||||
! Immediate operands
|
||||
UNION: immediate byte integer ;
|
||||
|
||||
GENERIC: fits-in-byte? ( value -- ? )
|
||||
|
||||
M: byte fits-in-byte? drop t ;
|
||||
|
||||
M: integer fits-in-byte? -128 127 between? ;
|
||||
|
||||
GENERIC: modifier ( op -- n )
|
||||
|
||||
M: indirect modifier
|
||||
dup base>> [
|
||||
displacement>> {
|
||||
{ [ dup not ] [ BIN: 00 ] }
|
||||
{ [ dup fits-in-byte? ] [ BIN: 01 ] }
|
||||
{ [ dup immediate? ] [ BIN: 10 ] }
|
||||
} cond nip
|
||||
] [
|
||||
drop BIN: 00
|
||||
] if ;
|
||||
|
||||
M: register modifier drop BIN: 11 ;
|
||||
|
||||
GENERIC# n, 1 ( value n -- )
|
||||
|
||||
M: integer n, >le % ;
|
||||
M: byte n, >r value>> r> n, ;
|
||||
: 1, ( n -- ) 1 n, ; inline
|
||||
: 4, ( n -- ) 4 n, ; inline
|
||||
: 2, ( n -- ) 2 n, ; inline
|
||||
: cell, ( n -- ) bootstrap-cell n, ; inline
|
||||
|
||||
: mod-r/m, ( reg# indirect -- )
|
||||
[ 3 shift ] [ [ modifier 6 shift ] [ r/m ] bi ] bi* bitor bitor , ;
|
||||
|
||||
: sib, ( indirect -- )
|
||||
dup sib-present? [
|
||||
[ indirect-base* ]
|
||||
[ indirect-index* 3 shift ]
|
||||
[ indirect-scale* 6 shift ] tri bitor bitor ,
|
||||
] [
|
||||
drop
|
||||
] if ;
|
||||
|
||||
GENERIC: displacement, ( op -- )
|
||||
|
||||
M: indirect displacement,
|
||||
dup displacement>> dup [
|
||||
swap base>>
|
||||
[ dup fits-in-byte? [ , ] [ 4, ] if ] [ 4, ] if
|
||||
] [
|
||||
2drop
|
||||
] if ;
|
||||
|
||||
M: register displacement, drop ;
|
||||
|
||||
: addressing ( reg# indirect -- )
|
||||
[ mod-r/m, ] [ sib, ] [ displacement, ] tri ;
|
||||
|
||||
! Utilities
|
||||
UNION: operand register indirect ;
|
||||
|
||||
GENERIC: operand-64? ( operand -- ? )
|
||||
|
||||
M: indirect operand-64?
|
||||
[ base>> ] [ index>> ] bi [ operand-64? ] either? ;
|
||||
|
||||
M: register-64 operand-64? drop t ;
|
||||
|
||||
M: object operand-64? drop f ;
|
||||
|
||||
: rex.w? ( rex.w reg r/m -- ? )
|
||||
{
|
||||
{ [ dup register-128? ] [ drop operand-64? ] }
|
||||
{ [ dup not ] [ drop operand-64? ] }
|
||||
[ nip operand-64? ]
|
||||
} cond and ;
|
||||
|
||||
: rex.r ( m op -- n )
|
||||
extended? [ BIN: 00000100 bitor ] when ;
|
||||
|
||||
: rex.b ( m op -- n )
|
||||
[ extended? [ BIN: 00000001 bitor ] when ] keep
|
||||
dup indirect? [
|
||||
index>> extended? [ BIN: 00000010 bitor ] when
|
||||
] [
|
||||
drop
|
||||
] if ;
|
||||
|
||||
: rex-prefix ( reg r/m rex.w -- )
|
||||
#! Compile an AMD64 REX prefix.
|
||||
2over rex.w? BIN: 01001000 BIN: 01000000 ?
|
||||
swap rex.r swap rex.b
|
||||
dup BIN: 01000000 = [ drop ] [ , ] if ;
|
||||
|
||||
: 16-prefix ( reg r/m -- )
|
||||
[ register-16? ] either? [ HEX: 66 , ] when ;
|
||||
|
||||
: prefix ( reg r/m rex.w -- ) 2over 16-prefix rex-prefix ;
|
||||
|
||||
: prefix-1 ( reg rex.w -- ) f swap prefix ;
|
||||
|
||||
: short-operand ( reg rex.w n -- )
|
||||
#! Some instructions encode their single operand as part of
|
||||
#! the opcode.
|
||||
>r dupd prefix-1 reg-code r> + , ;
|
||||
|
||||
: opcode, ( opcode -- ) dup array? [ % ] [ , ] if ;
|
||||
|
||||
: extended-opcode ( opcode -- opcode' ) OCT: 17 swap 2array ;
|
||||
|
||||
: extended-opcode, ( opcode -- ) extended-opcode opcode, ;
|
||||
|
||||
: opcode-or ( opcode mask -- opcode' )
|
||||
swap dup array?
|
||||
[ unclip-last rot bitor suffix ] [ bitor ] if ;
|
||||
|
||||
: 1-operand ( op reg,rex.w,opcode -- )
|
||||
#! The 'reg' is not really a register, but a value for the
|
||||
#! 'reg' field of the mod-r/m byte.
|
||||
first3 >r >r over r> prefix-1 r> opcode, swap addressing ;
|
||||
|
||||
: immediate-operand-size-bit ( imm dst reg,rex.w,opcode -- imm dst reg,rex.w,opcode )
|
||||
pick integer? [ first3 BIN: 1 opcode-or 3array ] when ;
|
||||
|
||||
: immediate-1 ( imm dst reg,rex.w,opcode -- )
|
||||
immediate-operand-size-bit 1-operand 1, ;
|
||||
|
||||
: immediate-4 ( imm dst reg,rex.w,opcode -- )
|
||||
immediate-operand-size-bit 1-operand 4, ;
|
||||
|
||||
: immediate-fits-in-size-bit ( imm dst reg,rex.w,opcode -- imm dst reg,rex.w,opcode )
|
||||
pick integer? [ first3 BIN: 10 opcode-or 3array ] when ;
|
||||
|
||||
: immediate-1/4 ( imm dst reg,rex.w,opcode -- )
|
||||
#! If imm is a byte, compile the opcode and the byte.
|
||||
#! Otherwise, set the 8-bit operand flag in the opcode, and
|
||||
#! compile the cell. The 'reg' is not really a register, but
|
||||
#! a value for the 'reg' field of the mod-r/m byte.
|
||||
pick fits-in-byte? [
|
||||
immediate-fits-in-size-bit immediate-1
|
||||
] [
|
||||
immediate-4
|
||||
] if ;
|
||||
|
||||
: (2-operand) ( dst src op -- )
|
||||
>r 2dup t rex-prefix r> opcode,
|
||||
reg-code swap addressing ;
|
||||
|
||||
: direction-bit ( dst src op -- dst' src' op' )
|
||||
pick register? [ BIN: 10 opcode-or swapd ] when ;
|
||||
|
||||
: operand-size-bit ( dst src op -- dst' src' op' )
|
||||
over register-8? [ BIN: 1 opcode-or ] unless ;
|
||||
|
||||
: 2-operand ( dst src op -- )
|
||||
#! Sets the opcode's direction bit. It is set if the
|
||||
#! destination is a direct register operand.
|
||||
2over 16-prefix
|
||||
direction-bit
|
||||
operand-size-bit
|
||||
(2-operand) ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: [] ( reg/displacement -- indirect )
|
||||
dup integer? [ >r f f f r> ] [ f f f ] if <indirect> ;
|
||||
|
||||
: [+] ( reg displacement -- indirect )
|
||||
dup integer?
|
||||
[ dup zero? [ drop f ] when >r f f r> ]
|
||||
[ f f ] if
|
||||
<indirect> ;
|
||||
|
||||
! Moving stuff
|
||||
GENERIC: PUSH ( op -- )
|
||||
M: register PUSH f HEX: 50 short-operand ;
|
||||
M: immediate PUSH HEX: 68 , 4, ;
|
||||
M: operand PUSH { BIN: 110 f HEX: ff } 1-operand ;
|
||||
|
||||
GENERIC: POP ( op -- )
|
||||
M: register POP f HEX: 58 short-operand ;
|
||||
M: operand POP { BIN: 000 f HEX: 8f } 1-operand ;
|
||||
|
||||
! MOV where the src is immediate.
|
||||
GENERIC: (MOV-I) ( src dst -- )
|
||||
M: register (MOV-I) t HEX: b8 short-operand cell, ;
|
||||
M: operand (MOV-I)
|
||||
{ BIN: 000 t HEX: c6 }
|
||||
pick byte? [ immediate-1 ] [ immediate-4 ] if ;
|
||||
|
||||
GENERIC: MOV ( dst src -- )
|
||||
M: immediate MOV swap (MOV-I) ;
|
||||
M: word MOV 0 rot (MOV-I) rc-absolute-cell rel-word ;
|
||||
M: operand MOV HEX: 88 2-operand ;
|
||||
|
||||
: LEA ( dst src -- ) swap HEX: 8d 2-operand ;
|
||||
|
||||
! Control flow
|
||||
GENERIC: JMP ( op -- )
|
||||
: (JMP) ( -- rel-class ) HEX: e9 , 0 4, rc-relative ;
|
||||
M: word JMP (JMP) rel-word ;
|
||||
M: label JMP (JMP) label-fixup ;
|
||||
M: operand JMP { BIN: 100 t HEX: ff } 1-operand ;
|
||||
|
||||
GENERIC: CALL ( op -- )
|
||||
: (CALL) ( -- rel-class ) HEX: e8 , 0 4, rc-relative ;
|
||||
M: word CALL (CALL) rel-word ;
|
||||
M: label CALL (CALL) label-fixup ;
|
||||
M: operand CALL { BIN: 010 t HEX: ff } 1-operand ;
|
||||
|
||||
GENERIC# JUMPcc 1 ( addr opcode -- )
|
||||
: (JUMPcc) ( n -- rel-class ) extended-opcode, 0 4, rc-relative ;
|
||||
M: word JUMPcc (JUMPcc) rel-word ;
|
||||
M: label JUMPcc (JUMPcc) label-fixup ;
|
||||
|
||||
: JO ( dst -- ) HEX: 80 JUMPcc ;
|
||||
: JNO ( dst -- ) HEX: 81 JUMPcc ;
|
||||
: JB ( dst -- ) HEX: 82 JUMPcc ;
|
||||
: JAE ( dst -- ) HEX: 83 JUMPcc ;
|
||||
: JE ( dst -- ) HEX: 84 JUMPcc ; ! aka JZ
|
||||
: JNE ( dst -- ) HEX: 85 JUMPcc ;
|
||||
: JBE ( dst -- ) HEX: 86 JUMPcc ;
|
||||
: JA ( dst -- ) HEX: 87 JUMPcc ;
|
||||
: JS ( dst -- ) HEX: 88 JUMPcc ;
|
||||
: JNS ( dst -- ) HEX: 89 JUMPcc ;
|
||||
: JP ( dst -- ) HEX: 8a JUMPcc ;
|
||||
: JNP ( dst -- ) HEX: 8b JUMPcc ;
|
||||
: JL ( dst -- ) HEX: 8c JUMPcc ;
|
||||
: JGE ( dst -- ) HEX: 8d JUMPcc ;
|
||||
: JLE ( dst -- ) HEX: 8e JUMPcc ;
|
||||
: JG ( dst -- ) HEX: 8f JUMPcc ;
|
||||
|
||||
: LEAVE ( -- ) HEX: c9 , ;
|
||||
: NOP ( -- ) HEX: 90 , ;
|
||||
|
||||
: RET ( n -- )
|
||||
dup zero? [ drop HEX: c3 , ] [ HEX: C2 , 2, ] if ;
|
||||
|
||||
! Arithmetic
|
||||
|
||||
GENERIC: ADD ( dst src -- )
|
||||
M: immediate ADD swap { BIN: 000 t HEX: 80 } immediate-1/4 ;
|
||||
M: operand ADD OCT: 000 2-operand ;
|
||||
|
||||
GENERIC: OR ( dst src -- )
|
||||
M: immediate OR swap { BIN: 001 t HEX: 80 } immediate-1/4 ;
|
||||
M: operand OR OCT: 010 2-operand ;
|
||||
|
||||
GENERIC: ADC ( dst src -- )
|
||||
M: immediate ADC swap { BIN: 010 t HEX: 80 } immediate-1/4 ;
|
||||
M: operand ADC OCT: 020 2-operand ;
|
||||
|
||||
GENERIC: SBB ( dst src -- )
|
||||
M: immediate SBB swap { BIN: 011 t HEX: 80 } immediate-1/4 ;
|
||||
M: operand SBB OCT: 030 2-operand ;
|
||||
|
||||
GENERIC: AND ( dst src -- )
|
||||
M: immediate AND swap { BIN: 100 t HEX: 80 } immediate-1/4 ;
|
||||
M: operand AND OCT: 040 2-operand ;
|
||||
|
||||
GENERIC: SUB ( dst src -- )
|
||||
M: immediate SUB swap { BIN: 101 t HEX: 80 } immediate-1/4 ;
|
||||
M: operand SUB OCT: 050 2-operand ;
|
||||
|
||||
GENERIC: XOR ( dst src -- )
|
||||
M: immediate XOR swap { BIN: 110 t HEX: 80 } immediate-1/4 ;
|
||||
M: operand XOR OCT: 060 2-operand ;
|
||||
|
||||
GENERIC: CMP ( dst src -- )
|
||||
M: immediate CMP swap { BIN: 111 t HEX: 80 } immediate-1/4 ;
|
||||
M: operand CMP OCT: 070 2-operand ;
|
||||
|
||||
: NOT ( dst -- ) { BIN: 010 t HEX: f7 } 1-operand ;
|
||||
: NEG ( dst -- ) { BIN: 011 t HEX: f7 } 1-operand ;
|
||||
: MUL ( dst -- ) { BIN: 100 t HEX: f7 } 1-operand ;
|
||||
: IMUL ( src -- ) { BIN: 101 t HEX: f7 } 1-operand ;
|
||||
: DIV ( dst -- ) { BIN: 110 t HEX: f7 } 1-operand ;
|
||||
: IDIV ( src -- ) { BIN: 111 t HEX: f7 } 1-operand ;
|
||||
|
||||
: CDQ ( -- ) HEX: 99 , ;
|
||||
: CQO ( -- ) HEX: 48 , CDQ ;
|
||||
|
||||
: ROL ( dst n -- ) swap { BIN: 000 t HEX: c0 } immediate-1 ;
|
||||
: ROR ( dst n -- ) swap { BIN: 001 t HEX: c0 } immediate-1 ;
|
||||
: RCL ( dst n -- ) swap { BIN: 010 t HEX: c0 } immediate-1 ;
|
||||
: RCR ( dst n -- ) swap { BIN: 011 t HEX: c0 } immediate-1 ;
|
||||
: SHL ( dst n -- ) swap { BIN: 100 t HEX: c0 } immediate-1 ;
|
||||
: SHR ( dst n -- ) swap { BIN: 101 t HEX: c0 } immediate-1 ;
|
||||
: SAR ( dst n -- ) swap { BIN: 111 t HEX: c0 } immediate-1 ;
|
||||
|
||||
GENERIC: IMUL2 ( dst src -- )
|
||||
M: immediate IMUL2 swap dup reg-code t HEX: 68 3array immediate-1/4 ;
|
||||
M: operand IMUL2 OCT: 257 extended-opcode (2-operand) ;
|
||||
|
||||
: MOVSX ( dst src -- )
|
||||
dup register-32? OCT: 143 OCT: 276 extended-opcode ?
|
||||
over register-16? [ BIN: 1 opcode-or ] when
|
||||
swapd
|
||||
(2-operand) ;
|
||||
|
||||
! Conditional move
|
||||
: MOVcc ( dst src cc -- ) extended-opcode swapd (2-operand) ;
|
||||
|
||||
: CMOVO ( dst src -- ) HEX: 40 MOVcc ;
|
||||
: CMOVNO ( dst src -- ) HEX: 41 MOVcc ;
|
||||
: CMOVB ( dst src -- ) HEX: 42 MOVcc ;
|
||||
: CMOVAE ( dst src -- ) HEX: 43 MOVcc ;
|
||||
: CMOVE ( dst src -- ) HEX: 44 MOVcc ; ! aka CMOVZ
|
||||
: CMOVNE ( dst src -- ) HEX: 45 MOVcc ;
|
||||
: CMOVBE ( dst src -- ) HEX: 46 MOVcc ;
|
||||
: CMOVA ( dst src -- ) HEX: 47 MOVcc ;
|
||||
: CMOVS ( dst src -- ) HEX: 48 MOVcc ;
|
||||
: CMOVNS ( dst src -- ) HEX: 49 MOVcc ;
|
||||
: CMOVP ( dst src -- ) HEX: 4a MOVcc ;
|
||||
: CMOVNP ( dst src -- ) HEX: 4b MOVcc ;
|
||||
: CMOVL ( dst src -- ) HEX: 4c MOVcc ;
|
||||
: CMOVGE ( dst src -- ) HEX: 4d MOVcc ;
|
||||
: CMOVLE ( dst src -- ) HEX: 4e MOVcc ;
|
||||
: CMOVG ( dst src -- ) HEX: 4f MOVcc ;
|
||||
|
||||
! CPU Identification
|
||||
|
||||
: CPUID ( -- ) HEX: a2 extended-opcode, ;
|
||||
|
||||
! x87 Floating Point Unit
|
||||
|
||||
: FSTPS ( operand -- ) { BIN: 011 f HEX: d9 } 1-operand ;
|
||||
: FSTPL ( operand -- ) { BIN: 011 f HEX: dd } 1-operand ;
|
||||
|
||||
: FLDS ( operand -- ) { BIN: 000 f HEX: d9 } 1-operand ;
|
||||
: FLDL ( operand -- ) { BIN: 000 f HEX: dd } 1-operand ;
|
||||
|
||||
! SSE multimedia instructions
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: direction-bit-sse ( dst src op1 -- dst' src' op1' )
|
||||
pick register-128? [ swapd ] [ BIN: 1 bitor ] if ;
|
||||
|
||||
: 2-operand-sse ( dst src op1 op2 -- )
|
||||
, direction-bit-sse extended-opcode (2-operand) ;
|
||||
|
||||
: 2-operand-int/sse ( dst src op1 op2 -- )
|
||||
, swapd extended-opcode (2-operand) ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: MOVSS ( dest src -- ) HEX: 10 HEX: f3 2-operand-sse ;
|
||||
: MOVSD ( dest src -- ) HEX: 10 HEX: f2 2-operand-sse ;
|
||||
: ADDSD ( dest src -- ) HEX: 58 HEX: f2 2-operand-sse ;
|
||||
: MULSD ( dest src -- ) HEX: 59 HEX: f2 2-operand-sse ;
|
||||
: SUBSD ( dest src -- ) HEX: 5c HEX: f2 2-operand-sse ;
|
||||
: DIVSD ( dest src -- ) HEX: 5e HEX: f2 2-operand-sse ;
|
||||
: SQRTSD ( dest src -- ) HEX: 51 HEX: f2 2-operand-sse ;
|
||||
: UCOMISD ( dest src -- ) HEX: 2e HEX: 66 2-operand-sse ;
|
||||
: COMISD ( dest src -- ) HEX: 2f HEX: 66 2-operand-sse ;
|
||||
|
||||
: CVTSS2SD ( dest src -- ) HEX: 5a HEX: f3 2-operand-sse ;
|
||||
: CVTSD2SS ( dest src -- ) HEX: 5a HEX: f2 2-operand-sse ;
|
||||
|
||||
: CVTSI2SD ( dest src -- ) HEX: 2a HEX: f2 2-operand-int/sse ;
|
||||
: CVTSD2SI ( dest src -- ) HEX: 2d HEX: f2 2-operand-int/sse ;
|
||||
: CVTTSD2SI ( dest src -- ) HEX: 2c HEX: f2 2-operand-int/sse ;
|
||||
|
|
@ -51,3 +51,8 @@ DEF(bool,check_sse2,(void)):
|
|||
ret
|
||||
|
||||
#include "cpu-x86.S"
|
||||
|
||||
#ifdef WINDOWS
|
||||
.section .drectve
|
||||
.ascii " -export:check_sse2"
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -4,5 +4,3 @@ register CELL ds asm("esi");
|
|||
register CELL rs asm("edi");
|
||||
|
||||
#define F_FASTCALL __attribute__ ((regparm (2)))
|
||||
|
||||
DLLEXPORT bool check_sse2(void);
|
||||
|
|
|
|||
Loading…
Reference in New Issue