projects / OpenSPARC-T2-SAM / blame
| Commit | Line | Data |
|---|---|---|
| 920dae64 AT |
1 | \ ========== Copyright Header Begin ========================================== |
| 2 | \ | |
| 3 | \ Hypervisor Software File: assem.fth | |
| 4 | \ | |
| 5 | \ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved. | |
| 6 | \ | |
| 7 | \ - Do no alter or remove copyright notices | |
| 8 | \ | |
| 9 | \ - Redistribution and use of this software in source and binary forms, with | |
| 10 | \ or without modification, are permitted provided that the following | |
| 11 | \ conditions are met: | |
| 12 | \ | |
| 13 | \ - Redistribution of source code must retain the above copyright notice, | |
| 14 | \ this list of conditions and the following disclaimer. | |
| 15 | \ | |
| 16 | \ - Redistribution in binary form must reproduce the above copyright notice, | |
| 17 | \ this list of conditions and the following disclaimer in the | |
| 18 | \ documentation and/or other materials provided with the distribution. | |
| 19 | \ | |
| 20 | \ Neither the name of Sun Microsystems, Inc. or the names of contributors | |
| 21 | \ may be used to endorse or promote products derived from this software | |
| 22 | \ without specific prior written permission. | |
| 23 | \ | |
| 24 | \ This software is provided "AS IS," without a warranty of any kind. | |
| 25 | \ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES, | |
| 26 | \ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A | |
| 27 | \ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN | |
| 28 | \ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR | |
| 29 | \ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR | |
| 30 | \ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN | |
| 31 | \ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR | |
| 32 | \ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE | |
| 33 | \ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY, | |
| 34 | \ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF | |
| 35 | \ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. | |
| 36 | \ | |
| 37 | \ You acknowledge that this software is not designed, licensed or | |
| 38 | \ intended for use in the design, construction, operation or maintenance of | |
| 39 | \ any nuclear facility. | |
| 40 | \ | |
| 41 | \ ========== Copyright Header End ============================================ | |
| 42 | \ @(#)assem.fth 2.29 06/02/16 | |
| 43 | \ Copyright 1985-1990 Bradley Forthware | |
| 44 | \ copyright: Copyright 2006 Sun Microsystems, Inc. All Rights Reserved | |
| 45 | \ copyright: Use is subject to license terms. | |
| 46 | ||
| 47 | \ requires case.f | |
| 48 | \ requires string-array.f | |
| 49 | ||
| 50 | vocabulary srassembler | |
| 51 | also srassembler definitions | |
| 52 | ||
| 53 | headerless | |
| 54 | alias lor or \ Because "or" gets redefined in the assembler | |
| 55 | alias land and \ Because "and" gets redefined in the assembler | |
| 56 | ||
| 57 | defer here \ For switching between resident and meta assembling | |
| 58 | defer asm-allot \ For switching between resident and meta assembling | |
| 59 | defer asm@ \ For switching between resident and meta assembling | |
| 60 | defer asm! \ For switching between resident and meta assembling | |
| 61 | defer /asm | |
| 62 | ||
| 63 | \ Install as a resident assembler | |
| 64 | : resident-assembler ( -- ) | |
| 65 | [ also forth ] ['] /l [ previous ] is /asm | |
| 66 | [ also forth ] ['] here [ previous ] is here | |
| 67 | [ also forth ] ['] allot [ previous ] is asm-allot | |
| 68 | [ also forth ] ['] l@ [ previous ] is asm@ | |
| 69 | [ also forth ] ['] instruction! [ previous ] is asm! | |
| 70 | ; | |
| 71 | ||
| 72 | resident-assembler | |
| 73 | ||
| 74 | ||
| 75 | decimal | |
| 76 | ||
| 77 | h# 1fff constant immedmask | |
| 78 | immedmask 1 + constant immedbit | |
| 79 | immedmask constant maximmed | |
| 80 | maximmed negate constant minimmed | |
| 81 | h# 1f constant regmask | |
| 82 | h# 1000.0000 constant regmagic | |
| 83 | h# ff constant asimask | |
| 84 | ||
| 85 | : reg ( n -- ) regmagic + ; | |
| 86 | : register \ name ( n -- ) | |
| 87 | create w, does> w@ reg | |
| 88 | ; | |
| 89 | ||
| 90 | headers | |
| 91 | ||
| 92 | 0 register %g0 1 register %g1 2 register %g2 3 register %g3 | |
| 93 | 4 register %g4 5 register %g5 6 register %g6 7 register %g7 | |
| 94 | 8 register %o0 9 register %o1 10 register %o2 11 register %o3 | |
| 95 | 12 register %o4 13 register %o5 14 register %o6 15 register %o7 | |
| 96 | 16 register %l0 17 register %l1 18 register %l2 19 register %l3 | |
| 97 | 20 register %l4 21 register %l5 22 register %l6 23 register %l7 | |
| 98 | 24 register %i0 25 register %i1 26 register %i2 27 register %i3 | |
| 99 | 28 register %i4 29 register %i5 30 register %i6 31 register %i7 | |
| 100 | ||
| 101 | 0 register %r0 1 register %r1 2 register %r2 3 register %r3 | |
| 102 | 4 register %r4 5 register %r5 6 register %r6 7 register %r7 | |
| 103 | 8 register %r8 9 register %r9 10 register %r10 11 register %r11 | |
| 104 | 12 register %r12 13 register %r13 14 register %r14 15 register %r15 | |
| 105 | 16 register %r16 17 register %r17 18 register %r18 19 register %r19 | |
| 106 | 20 register %r20 21 register %r21 22 register %r22 23 register %r23 | |
| 107 | 24 register %r24 25 register %r25 26 register %r26 27 register %r27 | |
| 108 | 28 register %r28 29 register %r29 30 register %r30 31 register %r31 | |
| 109 | ||
| 110 | 64 register %f0 65 register %f1 66 register %f2 67 register %f3 | |
| 111 | 68 register %f4 69 register %f5 70 register %f6 71 register %f7 | |
| 112 | 72 register %f8 73 register %f9 74 register %f10 75 register %f11 | |
| 113 | 76 register %f12 77 register %f13 78 register %f14 79 register %f15 | |
| 114 | 80 register %f16 81 register %f17 82 register %f18 83 register %f19 | |
| 115 | 84 register %f20 85 register %f21 86 register %f22 87 register %f23 | |
| 116 | 88 register %f24 89 register %f25 90 register %f26 91 register %f27 | |
| 117 | 92 register %f28 93 register %f29 94 register %f30 95 register %f31 | |
| 118 | ||
| 119 | 097 register %f32 099 register %f34 101 register %f36 103 register %f38 | |
| 120 | 105 register %f40 107 register %f42 109 register %f44 111 register %f46 | |
| 121 | 113 register %f48 115 register %f50 117 register %f52 119 register %f54 | |
| 122 | 121 register %f56 123 register %f58 125 register %f60 127 register %f62 | |
| 123 | ||
| 124 | 128 register %asi 129 register %xcc 130 register %icc | |
| 125 | ||
| 126 | headerless | |
| 127 | : isimmed? ( [ rs2 | imm ] -- f ) minimmed maximmed between ; | |
| 128 | : ?freg ( r -- r ) | |
| 129 | dup %f0 %f62 between 0= abort" Floating point register required" | |
| 130 | ; | |
| 131 | : ?ireg ( r -- r ) | |
| 132 | dup %g0 %i7 between 0= abort" Integer register required" | |
| 133 | ; | |
| 134 | : setbits ( opcode -- ) here /asm asm-allot asm! ; | |
| 135 | : opaddr ( -- addr ) here /asm - ; | |
| 136 | : tcc? ( -- flag ) | |
| 137 | opaddr asm@ d# 19 rshift h# 3f and b# 11.1010 = | |
| 138 | ; | |
| 139 | : addbits ( bits -- ) opaddr asm@ lor opaddr asm! ; | |
| 140 | : clearbits ( bits -- ) invert opaddr asm@ and opaddr asm! ; | |
| 141 | : regset ( reg shift -- ) swap regmask land swap << addbits ; | |
| 142 | : rs ( rs -- ) 14 regset ; | |
| 143 | : rd ( rd -- ) 25 regset ; | |
| 144 | : rs2 ( rs2 -- ) 0 regset ; | |
| 145 | : src ( rs1 [ rs2 | imm ] -- ) | |
| 146 | dup isimmed? if ( rs1 imm ) | |
| 147 | immedmask land immedbit lor addbits | |
| 148 | else ( rs1 rs2 ) | |
| 149 | rs2 | |
| 150 | then ( rs1 ) | |
| 151 | rs | |
| 152 | ; | |
| 153 | : %asi? ( asi -- flag ) %asi = ; | |
| 154 | : asrc ( rs1 [ rs2 | imm ] asi -- ) | |
| 155 | dup %asi? if ( rs1 imm asi ) | |
| 156 | drop dup isimmed? 0= ( rs1 imm flag ) | |
| 157 | abort" Immediate must be used with alternate space instructions" | |
| 158 | else ( rs1 rs2 asi ) | |
| 159 | asimask land 5 << addbits ( rs1 rs2 ) | |
| 160 | dup isimmed? ( rs1 rs2 flag ) | |
| 161 | abort" Immediate fields can't be used with alternate space instructions" | |
| 162 | then | |
| 163 | src | |
| 164 | ; | |
| 165 | ||
| 166 | : cas-src ( rs1 asi -- ) | |
| 167 | dup %asi? if ( rs1 %asi ) | |
| 168 | drop ( rs1 ) | |
| 169 | immedbit addbits ( rs1 ) | |
| 170 | else ( rs1 asi ) | |
| 171 | asimask land 5 << addbits ( rs1 ) | |
| 172 | then | |
| 173 | rs | |
| 174 | ; | |
| 175 | : set-op ( n class -- ) d# 30 << swap d# 19 << + setbits ; | |
| 176 | : wcreate ( n -- ) create w, [compile] does> compile w@ ; immediate | |
| 177 | : set-op2 ( n -- ) 2 set-op ; | |
| 178 | : w@set-op3 ( adr -- ) w@ 3 set-op ; | |
| 179 | : w@set-op2 ( adr -- ) w@ set-op2 ; | |
| 180 | : createw, ( n -- ) create w, ; | |
| 181 | ||
| 182 | \ Class 3 operations, loads and stores | |
| 183 | : op3 ( opcode -- ) | |
| 184 | createw, does> w@set-op3 ( rs1 [ rs2 | imm ] rd ) rd src | |
| 185 | ; | |
| 186 | ||
| 187 | \ Load from alternate address space instructions | |
| 188 | : opa ( opcode -- ) | |
| 189 | createw, does> w@set-op3 ( rs1 rs2 asi rd ) rd asrc | |
| 190 | ; | |
| 191 | ||
| 192 | \ For store instructions, where rd comes first | |
| 193 | : sop3 ( opcode -- ) | |
| 194 | createw, does> w@set-op3 ( rd rs1 [ rs2 | imm ] ) src rd | |
| 195 | ; | |
| 196 | ||
| 197 | \ For store alternate instructions, where rd comes first | |
| 198 | : sopa ( opcode -- ) | |
| 199 | createw, does> w@set-op3 ( rd rs1 rs2 asi ) asrc rd | |
| 200 | ; | |
| 201 | ||
| 202 | \ Class 3 operations, loads and stores | |
| 203 | : op3a ( opcode -- ) | |
| 204 | createw, does> w@set-op3 ( rs1 rs2 asi rd ) rd rs2 cas-src | |
| 205 | ; | |
| 206 | ||
| 207 | headers | |
| 208 | ||
| 209 | hex | |
| 210 | 00 op3 lduw 04 sop3 st 08 op3 ldsw | |
| 211 | 01 op3 ldub 05 sop3 stb 09 op3 ldsb 0d op3 ldstub | |
| 212 | 02 op3 lduh 06 sop3 sth 0a op3 ldsh 0e sop3 stx | |
| 213 | 03 op3 ldd 07 sop3 std 0b op3 ldx 0f op3 swapl | |
| 214 | ||
| 215 | 00 op3 ld \ V8 name for lduw | |
| 216 | ||
| 217 | 10 opa lda 14 sopa sta 18 opa ldswa | |
| 218 | 11 opa lduba 15 sopa stba 19 opa ldsba 1d opa ldstba | |
| 219 | 12 opa lduha 16 sopa stha 1a opa ldsha 1e sopa stxa | |
| 220 | 13 opa ldda 17 sopa stda 1b opa ldxa 1f opa swapa | |
| 221 | ||
| 222 | 20 op3 ldf 24 sop3 stf | |
| 223 | 21 op3 ldfsr 25 sop3 stfsr | |
| 224 | ||
| 225 | 32\ 22 op3 ldqf 26 sop3 stdfq | |
| 226 | 64\ 22 op3 ldqf 26 sop3 stqf 2d op3 prefetch | |
| 227 | ||
| 228 | 23 op3 lddf 27 sop3 stdf | |
| 229 | ||
| 230 | 30 op3 ldfa | |
| 231 | 3c op3a casa | |
| 232 | 32 opa ldqfa 3d opa prefetcha | |
| 233 | 33 opa lddfa 36 sopa stqfa 3e op3a casxa | |
| 234 | 34 sopa stfa 37 sopa stdfa | |
| 235 | ||
| 236 | : stxfsr %g1 -rot stfsr ; : ldxfsr %g1 ldfsr ; | |
| 237 | : stfsr %g0 -rot stfsr ; : ldfsr %g0 ldfsr ; | |
| 238 | ||
| 239 | \ XXX should these be op3's instead of opa's??? | |
| 240 | \ 30 opa ldc 34 sopa stc 38 op3 ldc2 3c op3 stc2 | |
| 241 | \ 31 opa ldcsr 35 sopa stcsr 39 op3 ldc3 3d op3 stc3 | |
| 242 | \ 36 sopa stdcq | |
| 243 | \ 33 opa lddc 37 sopa stdc | |
| 244 | ||
| 245 | 28 op3 ldf2 2c sop3 stf2 \ V8 Only | |
| 246 | 29 op3 ldf3 2d sop3 stf3 \ V8 Only | |
| 247 | ||
| 248 | headerless | |
| 249 | \ Class 2 operations, arithmetic and logical | |
| 250 | : op2 ( opcode -- ) | |
| 251 | createw, does> w@set-op2 ( rs1 [ rs2 | imm ] rd ) rd src | |
| 252 | ; | |
| 253 | \ For store instructions, where rd comes first | |
| 254 | : sop2 ( opcode -- ) | |
| 255 | createw, does> w@set-op3 ( rd rs1 [ rs2 | imm ] ) src rd | |
| 256 | ; | |
| 257 | ||
| 258 | \ Fixed source | |
| 259 | : dstop2 ( opcode -- ) | |
| 260 | createw, does> w@set-op2 ( rd ) rd | |
| 261 | ; | |
| 262 | \ Fixed destination | |
| 263 | : srcop2 ( opcode -- ) | |
| 264 | createw, does> w@set-op2 ( rs1 [ rs2 | imm ] ) src | |
| 265 | ; | |
| 266 | headers | |
| 267 | ||
| 268 | 00 op2 add 08 op2 addc 10 op2 addcc 18 op2 addccc | |
| 269 | 01 op2 and 09 op2 mulx 11 op2 andcc | |
| 270 | 02 op2 or 0a op2 umul 12 op2 orcc 1a op2 umulcc | |
| 271 | 03 op2 xor 0b op2 smul 13 op2 xorcc 1b op2 smulcc | |
| 272 | 04 op2 sub 0c op2 subc 14 op2 subcc 1c op2 subccc | |
| 273 | 05 op2 andn 0d op2 udivx 15 op2 andncc | |
| 274 | 06 op2 orn 0e op2 udiv 16 op2 orncc 1e op2 udivcc | |
| 275 | 07 op2 xnor 0f op2 sdiv 17 op2 xnorcc 1f op2 sdivcc | |
| 276 | ||
| 277 | 20 op2 taddcc 28 op2 rdasr 30 op2 wrasr 38 op2 jmpl | |
| 278 | 21 op2 tsubcc ( saved/restored ) 39 op2 return | |
| 279 | 22 op2 taddcctv 2a op2 rdpr 32 op2 wrpr ( Tcc ) | |
| 280 | 23 op2 tsubcctv ( flushw ) ( iflush ) | |
| 281 | 24 op2 mulscc ( MOVcc ) ( FPop1 ) 3c op2 save | |
| 282 | 25 op2 sll 2d op2 sdivx ( FPop2 ) 3d op2 restore | |
| 283 | 26 op2 srl 2e op2 popc ( IMPDEP1 ) ( done/retry ) | |
| 284 | 27 op2 sra ( MOVr ) ( IMPDEP2 ) | |
| 285 | ||
| 286 | 29 dstop2 rdpsr \ V8 Only | |
| 287 | 2a dstop2 rdwim \ V8 Only | |
| 288 | 2b dstop2 rdtbr \ V8 Only | |
| 289 | 31 srcop2 wrpsr \ V8 Only | |
| 290 | 32 srcop2 wrwim \ V8 Only | |
| 291 | 33 srcop2 wrtbr \ V8 Only | |
| 292 | 39 op2 rett \ V8 Only | |
| 293 | ||
| 294 | 1 constant #LoadLoad | |
| 295 | 2 constant #StoreLoad | |
| 296 | 4 constant #LoadStore | |
| 297 | 8 constant #StoreStore | |
| 298 | 10 constant #Lookaside | |
| 299 | 20 constant #MemIssue | |
| 300 | 40 constant #Sync | |
| 301 | ||
| 302 | : membar ( imm -- ) %o7 swap %g0 rdasr ; | |
| 303 | ||
| 304 | \ rd is always 0 for return | |
| 305 | : return ( rs1 { rs2 | imm } -- ) %g0 return ; | |
| 306 | ||
| 307 | \ rs2 is always %g0 for RDASR Instruction | |
| 308 | : rdasr ( rs1 rd -- ) %g0 swap rdasr ; | |
| 309 | ||
| 310 | \ rs2 is always %g0 for RDPR Instruction | |
| 311 | : rdpr ( rs1 rd -- ) %g0 swap rdpr ; | |
| 312 | ||
| 313 | alias addx addc \ 08 op2 addx SPARC V8 name | |
| 314 | alias subx subc \ 0c op2 subx SPARC V8 name | |
| 315 | alias addxcc addccc \ 18 op2 addxcc SPARC V8 name | |
| 316 | alias subxcc subccc \ 1c op2 subxcc SPARC V8 name | |
| 317 | ||
| 318 | ||
| 319 | : sllx sll 1000 addbits ; \ V9 | |
| 320 | : srlx srl 1000 addbits ; \ V9 | |
| 321 | : srax sra 1000 addbits ; \ V9 | |
| 322 | ||
| 323 | : rdy ( rd -- ) %g0 swap rdasr ; \ Special case of RDASR | |
| 324 | : wry ( rs1 [ rs2 | imm ] -- ) %g0 wrasr ; \ Special case of WRASR | |
| 325 | ||
| 326 | : rdccr ( rd -- ) %g2 swap rdasr ; \ Special case of RDASR | |
| 327 | : wrccr ( rs1 [ rs2 | imm ] -- ) %g2 wrasr ; \ Special case of WRASR | |
| 328 | ||
| 329 | : rdasi ( rd -- ) %g3 swap rdasr ; \ Special case of RDASR | |
| 330 | : wrasi ( rs1 [ rs2 | imm ] -- ) %g3 wrasr ; \ Special case of WRASR | |
| 331 | ||
| 332 | : rdtick ( rd -- ) %g4 swap rdasr ; \ Special case of RDASR | |
| 333 | ||
| 334 | : rdpc ( rd -- ) %g5 swap rdasr ; \ Special case of RDASR | |
| 335 | ||
| 336 | : rdfprs ( rd -- ) %g6 swap rdasr ; \ Special case of RDASR | |
| 337 | : wrfprs ( rs1 [ rs2 | imm ] -- ) %g6 wrasr ; \ Special case of WRASR | |
| 338 | ||
| 339 | : popc ( [ rs2 | imm ] rd -- ) %g0 -rot popc ; \ V9 | |
| 340 | : flushw ( -- ) 2b set-op2 ; \ V9 | |
| 341 | : saved ( -- ) 31 set-op2 %g0 rd ; \ V9 | |
| 342 | : restored ( -- ) 31 set-op2 %g1 rd ; \ V9 | |
| 343 | : done ( -- ) 3e set-op2 %g0 rd ; \ V9 | |
| 344 | : retry ( -- ) 3e set-op2 %g1 rd ; \ V9 | |
| 345 | ||
| 346 | headerless | |
| 347 | : wrpr: ( rd --) \ name | |
| 348 | create c, does> c@ %g0 lor ( rs1 rs2 rd ) wrpr | |
| 349 | ; | |
| 350 | : rdpr: ( rs1 --) \ name | |
| 351 | create c, does> c@ %g0 lor ( rd rs1 ) swap rdpr | |
| 352 | ; | |
| 353 | headers | |
| 354 | ||
| 355 | d# 0 wrpr: wrtpc ( rs1 [ rs2 | imm ] -- ) | |
| 356 | d# 1 wrpr: wrtnpc ( rs1 [ rs2 | imm ] -- ) | |
| 357 | d# 2 wrpr: wrtstate ( rs1 [ rs2 | imm ] -- ) | |
| 358 | d# 3 wrpr: wrtt ( rs1 [ rs2 | imm ] -- ) | |
| 359 | d# 4 wrpr: wrtick ( rs1 [ rs2 | imm ] -- ) | |
| 360 | d# 5 wrpr: wrtba ( rs1 [ rs2 | imm ] -- ) | |
| 361 | d# 6 wrpr: wrpstate ( rs1 [ rs2 | imm ] -- ) | |
| 362 | d# 7 wrpr: wrtl ( rs1 [ rs2 | imm ] -- ) | |
| 363 | d# 8 wrpr: wrpil ( rs1 [ rs2 | imm ] -- ) | |
| 364 | d# 9 wrpr: wrcwp ( rs1 [ rs2 | imm ] -- ) | |
| 365 | d# 10 wrpr: wrcansave ( rs1 [ rs2 | imm ] -- ) | |
| 366 | d# 11 wrpr: wrcanrestore ( rs1 [ rs2 | imm ] -- ) | |
| 367 | d# 12 wrpr: wrcleanwin ( rs1 [ rs2 | imm ] -- ) | |
| 368 | d# 13 wrpr: wrotherwin ( rs1 [ rs2 | imm ] -- ) | |
| 369 | d# 14 wrpr: wrwstate ( rs1 [ rs2 | imm ] -- ) | |
| 370 | ||
| 371 | d# 0 rdpr: rdtpc ( rd -- ) | |
| 372 | d# 1 rdpr: rdtnpc ( rd -- ) | |
| 373 | d# 2 rdpr: rdtstate ( rd -- ) | |
| 374 | d# 3 rdpr: rdtt ( rd -- ) | |
| 375 | d# 4 rdpr: rdtick ( rd -- ) | |
| 376 | d# 5 rdpr: rdtba ( rd -- ) | |
| 377 | d# 6 rdpr: rdpstate ( rd -- ) | |
| 378 | d# 7 rdpr: rdtl ( rd -- ) | |
| 379 | d# 8 rdpr: rdpil ( rd -- ) | |
| 380 | d# 9 rdpr: rdcwp ( rd -- ) | |
| 381 | d# 10 rdpr: rdcansave ( rd -- ) | |
| 382 | d# 11 rdpr: rdcanrestore ( rd -- ) | |
| 383 | d# 12 rdpr: rdcleanwin ( rd -- ) | |
| 384 | d# 13 rdpr: rdotherwin ( rd -- ) | |
| 385 | d# 14 rdpr: rdwstate ( rd -- ) | |
| 386 | [ifndef] SUN4V | |
| 387 | d# 31 rdpr: rdver ( rd -- ) | |
| 388 | [then] | |
| 389 | ||
| 390 | : ,%icc ( -- ) | |
| 391 | tcc? if h# 1800 else h# 30.0000 then | |
| 392 | clearbits | |
| 393 | ; | |
| 394 | : ,%xcc ( -- ) | |
| 395 | ,%icc tcc? if h# 1000 else h# 20.0000 then | |
| 396 | addbits | |
| 397 | ; | |
| 398 | ||
| 399 | : trapif ( src cond -- ) | |
| 400 | h# 3a set-op2 addbits | |
| 401 | dup isimmed? if h# 7f land then | |
| 402 | src | |
| 403 | 64\ ,%xcc | |
| 404 | ; | |
| 405 | ||
| 406 | : iflush ( src -- ) 3b set-op2 src ; | |
| 407 | : stbar ( -- ) %o7 %g0 rdasr ; | |
| 408 | \ This really should be a sethi instruction, because the %g0 can generate | |
| 409 | \ a pipeline dependency interlock resulting in a wasted cycle. | |
| 410 | \ : nop %g0 %g0 %g0 add ; | |
| 411 | ||
| 412 | \ Floating-point operations | |
| 413 | ||
| 414 | headerless | |
| 415 | : set-opf ( apf -- ) 34 set-op2 w@ 5 << addbits ; | |
| 416 | : ffop \ name ( opcode -- ) | |
| 417 | createw, does> set-opf ( frs frd ) ?freg rd ?freg rs2 | |
| 418 | ; | |
| 419 | headers | |
| 420 | ||
| 421 | 0c9 ffop fstod 0cd ffop fstox | |
| 422 | 0c6 ffop fdtos 0ce ffop fdtox | |
| 423 | 0c7 ffop fxtos 0cb ffop fxtod | |
| 424 | ||
| 425 | 001 ffop fmovs 002 ffop fmovd 003 ffop fmovq | |
| 426 | 005 ffop fnegs 006 ffop fnegd 007 ffop fnegq | |
| 427 | 009 ffop fabss 00a ffop fabsd 00b ffop fabsq | |
| 428 | 029 ffop fsqrts 02a ffop fsqrtd 02b ffop fsqrtx | |
| 429 | ||
| 430 | 0c4 ffop fitos 0c8 ffop fitod 0cc ffop fitox | |
| 431 | ||
| 432 | 0c1 ffop fstoir 0c2 ffop fdtoir 0c3 ffop fxtoir | |
| 433 | 0d1 ffop fstoi 0d2 ffop fdtoi 0d3 ffop fxtoi | |
| 434 | ||
| 435 | headerless | |
| 436 | : f2op \ name ( opcode -- ) | |
| 437 | createw, | |
| 438 | does> set-opf ( frs1 frs2 frd ) ?freg rd ?freg rs2 ?freg rs | |
| 439 | ; | |
| 440 | headers | |
| 441 | 041 f2op fadds 042 f2op faddd 043 f2op faddx | |
| 442 | 045 f2op fsubs 046 f2op fsubd 047 f2op fsubx | |
| 443 | 049 f2op fmuls 04a f2op fmuld 04b f2op fmulx | |
| 444 | 04d f2op fdivs 04e f2op fdivd 04f f2op fdivx | |
| 445 | ||
| 446 | headerless | |
| 447 | : fcmpop \ name ( opcode -- ) | |
| 448 | createw, does> set-opf ( frs1 frs2 ) | |
| 449 | 1 d# 19 << addbits ( frs1 frs2 apf ) | |
| 450 | ?freg rs2 ?freg rs | |
| 451 | ; | |
| 452 | headers | |
| 453 | 051 fcmpop fcmps 052 fcmpop fcmpd 053 fcmpop fcmpx | |
| 454 | 055 fcmpop fcmpes 056 fcmpop fcmped 057 fcmpop fcmpex | |
| 455 | ||
| 456 | headerless | |
| 457 | hex | |
| 458 | : cond ( bits -- ) createw, does> w@ d# 25 << ; | |
| 459 | ||
| 460 | headers | |
| 461 | \ Condition names. There are more of these near the end of the file. | |
| 462 | ||
| 463 | 8 cond always 0 cond never c cond hi 4 cond ls | |
| 464 | d cond cc 5 cond cs 9 cond ne 1 cond eq | |
| 465 | f cond vc 7 cond vs e cond pl 6 cond mi | |
| 466 | b cond ge 3 cond lt a cond gt 2 cond le | |
| 467 | ||
| 468 | headerless | |
| 469 | : -cond ( condition -- not-condition ) | |
| 470 | h# 1000.0000 [ also forth ] xor [ previous ] | |
| 471 | ; | |
| 472 | ||
| 473 | : op0 ( op -- ) d# 22 << setbits ; | |
| 474 | headers | |
| 475 | : unimp ( -- ) 0 op0 ; | |
| 476 | : sethi ( value rd -- ) 4 op0 rd n->l d# 10 >> addbits ; | |
| 477 | : nop ( -- ) 0 %g0 sethi ; | |
| 478 | headerless | |
| 479 | : fits-immediate-field? ( value -- flag ) | |
| 480 | h# ffff.f000 l->n h# 0000.0fff between | |
| 481 | ; | |
| 482 | headers | |
| 483 | : setuw ( value rd -- ) | |
| 484 | over n->l fits-immediate-field? if | |
| 485 | \ The value is small enough to omit the sethi instruction | |
| 486 | \ h# 1fff land %g0 swap add | |
| 487 | %g0 rot h# 1fff land rot or | |
| 488 | else | |
| 489 | \ We have to use sethi for the high-order bits | |
| 490 | 2dup sethi ( value rd ) | |
| 491 | swap h# 0000.03ff land tuck ( masked-value rd masked-value ) | |
| 492 | if tuck or \ Merge in the low bits | |
| 493 | else 2drop \ No need to merge in low-order zeroes | |
| 494 | then | |
| 495 | then | |
| 496 | ; | |
| 497 | alias set setuw | |
| 498 | ||
| 499 | : setsw ( value rd -- ) | |
| 500 | 2dup set ( value rd ) | |
| 501 | swap 0< if ( rd ) | |
| 502 | %g0 over sra ( ) | |
| 503 | else ( rd ) | |
| 504 | drop | |
| 505 | then | |
| 506 | ; | |
| 507 | : setx ( value reg rd -- ) | |
| 508 | rot dup fits-immediate-field? if ( reg rd value ) | |
| 509 | %g0 swap rot or drop exit ( ) | |
| 510 | then ( reg rd value ) | |
| 511 | dup d# 32 >> ?dup if ( reg rd value value-hi ) | |
| 512 | 2over drop tuck setuw ( reg rd value reg ) | |
| 513 | over n->l if ( reg rd value reg ) | |
| 514 | d# 32 over sllx ( reg rd value ) | |
| 515 | else ( reg rd value reg ) | |
| 516 | 2over d# 32 swap sllx drop ( reg rd value reg ) | |
| 517 | then ( reg rd value ) | |
| 518 | n->l tuck if ( reg val-lo rd ) | |
| 519 | tuck setuw ( reg rd ) | |
| 520 | tuck or ( ) | |
| 521 | else ( reg value rd ) | |
| 522 | 3drop ( ) | |
| 523 | then ( ) | |
| 524 | else ( reg rd value ) | |
| 525 | swap setuw drop ( ) | |
| 526 | then ( ) | |
| 527 | ; | |
| 528 | ||
| 529 | : ret ( -- ) %i7 8 %g0 jmpl ; | |
| 530 | : retl ( -- ) %o7 8 %g0 jmpl ; | |
| 531 | ||
| 532 | : ,a ( -- ) h# 2000.0000 addbits ; | |
| 533 | : ,pt ( -- ) h# 0008.0000 addbits ; | |
| 534 | : ,pn ( -- ) h# 0008.0000 clearbits ; | |
| 535 | alias annul ,a | |
| 536 | ||
| 537 | headerless | |
| 538 | : offset-22 ( target-adr branch-adr -- masked-displacement ) | |
| 539 | - 2 >>a | |
| 540 | dup h# -001f.ffff h# 001f.ffff between | |
| 541 | 0= abort" displacement out of 22-bit range" | |
| 542 | h# 3f.ffff land | |
| 543 | ; | |
| 544 | \ All longword displacements are guaranteed to be in a 30 bit range | |
| 545 | : offset-30 ( destination-adr branch-adr -- masked-displacement ) | |
| 546 | - 2 >>a | |
| 547 | h# 3fff.ffff land | |
| 548 | ; | |
| 549 | : branch: \ name ( op -- ) | |
| 550 | createw, | |
| 551 | does> w@ ( adr condition type ) op0 addbits opaddr offset-22 addbits | |
| 552 | ; | |
| 553 | ||
| 554 | : offset-16 ( target-adr branch-adr -- disp16lo disp16hi ) | |
| 555 | - 2 >>a | |
| 556 | dup h# -0000.7fff h# 0000.7fff between | |
| 557 | 0= abort" displacement out of 16-bit range" | |
| 558 | h# 0.ffff land | |
| 559 | dup h# 0.3fff land swap | |
| 560 | d# 13 >> d# 20 << lor | |
| 561 | ; | |
| 562 | ||
| 563 | : offset-19 ( target-adr branch-adr -- masked-displacement ) | |
| 564 | - 2 >>a | |
| 565 | dup h# -0007.ffff h# 0007.ffff between | |
| 566 | 0= abort" displacement out of 19-bit range" | |
| 567 | h# 07.ffff land | |
| 568 | ; | |
| 569 | : %icc? ( reg -- flag ) %icc = ; | |
| 570 | : %xcc? ( reg -- flag ) %xcc = ; | |
| 571 | : bpcc: \ name ( op -- ) | |
| 572 | createw, | |
| 573 | does> w@ ( [ icc | xcc ] adr cond type ) | |
| 574 | op0 ( [ icc | xcc ] adr cond ) | |
| 575 | addbits ( [ icc | xcc ] adr ) | |
| 576 | opaddr offset-19 addbits ( [ icc | xcc ] ) | |
| 577 | dup %icc? if | |
| 578 | drop ,%icc | |
| 579 | else | |
| 580 | dup %xcc? if | |
| 581 | drop ,%xcc | |
| 582 | else | |
| 583 | ??cr ." Bad CC register " .x cr | |
| 584 | then | |
| 585 | then | |
| 586 | ,pt | |
| 587 | ; | |
| 588 | : bpr: \ name ( rcond -- ) | |
| 589 | createw, | |
| 590 | does> w@ ( rs1 adr condition ) | |
| 591 | 3 op0 ( rs1 adr condition ) | |
| 592 | d# 25 << addbits ( rs1 adr ) | |
| 593 | opaddr ( rs1 target-adr branch-adr ) | |
| 594 | offset-16 addbits rs ,pt | |
| 595 | ; | |
| 596 | ||
| 597 | : offset-19/22 ( target-adr branch-adr -- displacement ) | |
| 598 | dup asm@ d# 22 >> 7 land 1 = if offset-19 else offset-22 then | |
| 599 | ; | |
| 600 | headers | |
| 601 | 2 branch: brif ( adr condition -- ) \ Integer Cond. Codes | |
| 602 | 6 branch: brfif ( adr condition -- ) \ Floating Point Cond. Codes | |
| 603 | 7 branch: brcif ( adr condition -- ) \ Coprocessor Cond. Codes | |
| 604 | ||
| 605 | : branch! ( target-adr branch-adr -- ) | |
| 606 | tuck offset-22 3080.0000 + swap asm! | |
| 607 | ; | |
| 608 | ||
| 609 | 1 bpcc: bprif ( [ icc | xcc ] adr cond -- ) \ Prediction reg. Integer CC | |
| 610 | 5 bpcc: bprfif ( [ icc | xcc ] adr cond -- ) \ Prediction reg. Floating CC | |
| 611 | : bpra ( [ icc | xcc ] adr -- ) always bprif ; | |
| 612 | ||
| 613 | : bra ( adr -- ) always brif ; | |
| 614 | ||
| 615 | 1 bpr: brz 2 bpr: brlez 3 bpr: brlz | |
| 616 | 5 bpr: brnz 6 bpr: brgz 7 bpr: brgez | |
| 617 | ||
| 618 | : call ( adr -- ) h# 4000.0000 setbits opaddr offset-30 addbits ; | |
| 619 | ||
| 620 | : but ( mark1 mark2 -- mark2 mark1 ) swap ; | |
| 621 | ||
| 622 | 64\ : brif ( adr condition -- ) %xcc -rot bprif ; | |
| 623 | ||
| 624 | headerless | |
| 625 | : <mark ( -- <mark ) here ; | |
| 626 | : >mark ( -- >mark ) here ; | |
| 627 | : >resolve ( >mark -- ) | |
| 628 | here over ( >mark here >mark ) | |
| 629 | offset-19/22 ( >mark displacement ) | |
| 630 | over asm@ + ( >mark opcode ) | |
| 631 | swap asm! ( ) | |
| 632 | ; | |
| 633 | ||
| 634 | \ >+resolve is used when the resolution follows a branch, | |
| 635 | \ so the delay slot must be skipped | |
| 636 | : >+resolve ( >mark -- ) | |
| 637 | here la1+ over ( >mark here+4 >mark ) | |
| 638 | offset-19/22 ( >mark displacement ) | |
| 639 | over asm@ + ( >mark opcode ) | |
| 640 | swap asm! ( ) | |
| 641 | ; | |
| 642 | : <resolve ( -- ) ; | |
| 643 | headers | |
| 644 | ||
| 645 | \ Define these last to delay overloading of the forth versions | |
| 646 | ||
| 647 | hex | |
| 648 | 1 cond = 1 cond 0= | |
| 649 | 2 cond <= 2 cond 0<= | |
| 650 | 3 cond < | |
| 651 | 4 cond u<= | |
| 652 | 5 cond u< | |
| 653 | 6 cond 0< | |
| 654 | 9 cond <> 9 cond 0<> | |
| 655 | a cond > a cond 0> | |
| 656 | b cond >= | |
| 657 | c cond u> | |
| 658 | d cond u>= | |
| 659 | e cond 0>= | |
| 660 | ||
| 661 | ||
| 662 | : if ( cond -- >mark ) >mark here rot -cond brif ; | |
| 663 | : ahead ( -- >mark ) never if ; | |
| 664 | : then ( >mark -- ) >resolve ; | |
| 665 | : else ( >mark -- >mark1 ) ahead but >+resolve ; | |
| 666 | : begin ( -- <mark ) <mark ; | |
| 667 | : while ( <mark cond -- <mark >mark ) if but ; | |
| 668 | : until ( <mark cond -- ) -cond brif ; | |
| 669 | : again ( <mark -- ) bra ; | |
| 670 | : repeat ( <mark >mark -- ) again >+resolve ; | |
| 671 | ||
| 672 | previous definitions |