projects / simh.git / blame
| Commit | Line | Data |
|---|---|---|
| 196ba1fc PH |
1 | /* vax_octa.c - VAX octaword and h_floating instructions\r |
| 2 | \r | |
| 3 | Copyright (c) 2004-2008, Robert M Supnik\r | |
| 4 | \r | |
| 5 | Permission is hereby granted, free of charge, to any person obtaining a\r | |
| 6 | copy of this software and associated documentation files (the "Software"),\r | |
| 7 | to deal in the Software without restriction, including without limitation\r | |
| 8 | the rights to use, copy, modify, merge, publish, distribute, sublicense,\r | |
| 9 | and/or sell copies of the Software, and to permit persons to whom the\r | |
| 10 | Software is furnished to do so, subject to the following conditions:\r | |
| 11 | \r | |
| 12 | The above copyright notice and this permission notice shall be included in\r | |
| 13 | all copies or substantial portions of the Software.\r | |
| 14 | \r | |
| 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR\r | |
| 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,\r | |
| 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL\r | |
| 18 | ROBERT M SUPNIK BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER\r | |
| 19 | IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN\r | |
| 20 | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.\r | |
| 21 | \r | |
| 22 | Except as contained in this notice, the name of Robert M Supnik shall not be\r | |
| 23 | used in advertising or otherwise to promote the sale, use or other dealings\r | |
| 24 | in this Software without prior written authorization from Robert M Supnik.\r | |
| 25 | \r | |
| 26 | This module simulates the VAX h_floating instruction set.\r | |
| 27 | \r | |
| 28 | 28-May-08 RMS Inlined physical memory routines\r | |
| 29 | 10-May-06 RMS Fixed bug in reported VA on faulting cross-page write\r | |
| 30 | 03-May-06 RMS Fixed MNEGH to test negated sign, clear C\r | |
| 31 | Fixed carry propagation in qp_inc, qp_neg, qp_add\r | |
| 32 | Fixed pack routines to test for zero via fraction\r | |
| 33 | Fixed ACBH to set cc's on result\r | |
| 34 | Fixed POLYH to set R3 correctly\r | |
| 35 | Fixed POLYH to not exit prematurely if arg = 0\r | |
| 36 | Fixed POLYH to mask mul reslt to 127b\r | |
| 37 | Fixed fp add routine to test for zero via fraction\r | |
| 38 | to support "denormal" argument from POLYH\r | |
| 39 | Fixed EMODH to concatenate 15b of 16b extension\r | |
| 40 | (all reported by Tim Stark)\r | |
| 41 | 15-Jul-04 RMS Cloned from 32b VAX floating point implementation\r | |
| 42 | */\r | |
| 43 | \r | |
| 44 | #include "vax_defs.h"\r | |
| 45 | \r | |
| 46 | #if defined (FULL_VAX)\r | |
| 47 | \r | |
| 48 | extern int32 R[16];\r | |
| 49 | extern int32 PSL;\r | |
| 50 | extern int32 trpirq;\r | |
| 51 | extern int32 p1;\r | |
| 52 | extern jmp_buf save_env;\r | |
| 53 | \r | |
| 54 | extern int32 Test (uint32 va, int32 acc, int32 *status);\r | |
| 55 | \r | |
| 56 | #define WORDSWAP(x) ((((x) & WMASK) << 16) | (((x) >> 16) & WMASK))\r | |
| 57 | \r | |
| 58 | typedef struct {\r | |
| 59 | uint32 f0; /* low */\r | |
| 60 | uint32 f1;\r | |
| 61 | uint32 f2;\r | |
| 62 | uint32 f3; /* high */\r | |
| 63 | } UQP;\r | |
| 64 | \r | |
| 65 | typedef struct {\r | |
| 66 | int32 sign;\r | |
| 67 | int32 exp;\r | |
| 68 | UQP frac;\r | |
| 69 | } UFPH;\r | |
| 70 | \r | |
| 71 | #define UH_NM_H 0x80000000 /* normalized */\r | |
| 72 | #define UH_FRND 0x00000080 /* F round */\r | |
| 73 | #define UH_DRND 0x00000080 /* D round */\r | |
| 74 | #define UH_GRND 0x00000400 /* G round */\r | |
| 75 | #define UH_HRND 0x00004000 /* H round */\r | |
| 76 | #define UH_V_NM 127\r | |
| 77 | \r | |
| 78 | int32 op_tsth (int32 val);\r | |
| 79 | int32 op_cmph (int32 *hf1, int32 *hf2);\r | |
| 80 | int32 op_cvtih (int32 val, int32 *hf);\r | |
| 81 | int32 op_cvthi (int32 *hf, int32 *flg, int32 opc);\r | |
| 82 | int32 op_cvtfdh (int32 vl, int32 vh, int32 *hf);\r | |
| 83 | int32 op_cvtgh (int32 vl, int32 vh, int32 *hf);\r | |
| 84 | int32 op_cvthfd (int32 *hf, int32 *vh);\r | |
| 85 | int32 op_cvthg (int32 *hf, int32 *vh);\r | |
| 86 | int32 op_addh (int32 *opnd, int32 *hf, t_bool sub);\r | |
| 87 | int32 op_mulh (int32 *opnd, int32 *hf);\r | |
| 88 | int32 op_divh (int32 *opnd, int32 *hf);\r | |
| 89 | int32 op_emodh (int32 *opnd, int32 *hflt, int32 *intgr, int32 *flg);\r | |
| 90 | void op_polyh (int32 *opnd, int32 acc);\r | |
| 91 | void h_write_b (int32 spec, int32 va, int32 val, int32 acc);\r | |
| 92 | void h_write_w (int32 spec, int32 va, int32 val, int32 acc);\r | |
| 93 | void h_write_l (int32 spec, int32 va, int32 val, int32 acc);\r | |
| 94 | void h_write_q (int32 spec, int32 va, int32 vl, int32 vh, int32 acc);\r | |
| 95 | void h_write_o (int32 spec, int32 va, int32 *val, int32 acc);\r | |
| 96 | void vax_hadd (UFPH *a, UFPH *b);\r | |
| 97 | void vax_hmul (UFPH *a, UFPH *b, uint32 mlo);\r | |
| 98 | void vax_hmod (UFPH *a, int32 *intgr, int32 *flg);\r | |
| 99 | void vax_hdiv (UFPH *a, UFPH *b);\r | |
| 100 | uint32 qp_add (UQP *a, UQP *b);\r | |
| 101 | uint32 qp_sub (UQP *a, UQP *b);\r | |
| 102 | void qp_inc (UQP *a);\r | |
| 103 | void qp_lsh (UQP *a, uint32 sc);\r | |
| 104 | void qp_rsh (UQP *a, uint32 sc);\r | |
| 105 | void qp_rsh_s (UQP *a, uint32 sc, uint32 neg);\r | |
| 106 | void qp_neg (UQP *a);\r | |
| 107 | int32 qp_cmp (UQP *a, UQP *b);\r | |
| 108 | void h_unpackfd (int32 hi, int32 lo, UFPH *a);\r | |
| 109 | void h_unpackg (int32 hi, int32 lo, UFPH *a);\r | |
| 110 | void h_unpackh (int32 *hflt, UFPH *a);\r | |
| 111 | void h_normh (UFPH *a);\r | |
| 112 | int32 h_rpackfd (UFPH *a, int32 *rl);\r | |
| 113 | int32 h_rpackg (UFPH *a, int32 *rl);\r | |
| 114 | int32 h_rpackh (UFPH *a, int32 *hflt);\r | |
| 115 | \r | |
| 116 | static int32 z_octa[4] = { 0, 0, 0, 0 };\r | |
| 117 | \r | |
| 118 | /* Octaword instructions */\r | |
| 119 | \r | |
| 120 | int32 op_octa (int32 *opnd, int32 cc, int32 opc, int32 acc, int32 spec, int32 va)\r | |
| 121 | {\r | |
| 122 | int32 r, rh, temp, flg;\r | |
| 123 | int32 r_octa[4];\r | |
| 124 | \r | |
| 125 | switch (opc) {\r | |
| 126 | \r | |
| 127 | /* PUSHAO\r | |
| 128 | \r | |
| 129 | opnd[0] = src.ao\r | |
| 130 | */\r | |
| 131 | \r | |
| 132 | case PUSHAO:\r | |
| 133 | Write (SP - 4, opnd[0], L_LONG, WA); /* push operand */\r | |
| 134 | SP = SP - 4; /* decr stack ptr */\r | |
| 135 | CC_IIZP_L (opnd[0]); /* set cc's */\r | |
| 136 | break;\r | |
| 137 | \r | |
| 138 | /* MOVAO\r | |
| 139 | \r | |
| 140 | opnd[0] = src.ro\r | |
| 141 | opnd[1:2] = dst.wl\r | |
| 142 | spec = last specifier\r | |
| 143 | va = address if last specifier is memory\r | |
| 144 | */\r | |
| 145 | \r | |
| 146 | case MOVAO:\r | |
| 147 | h_write_l (spec, va, opnd[0], acc); /* write operand */\r | |
| 148 | CC_IIZP_L (opnd[0]); /* set cc's */\r | |
| 149 | break;\r | |
| 150 | \r | |
| 151 | /* CLRO\r | |
| 152 | \r | |
| 153 | opnd[0:1] = dst.wl\r | |
| 154 | spec = last specifier\r | |
| 155 | va = address if last specifier is memory\r | |
| 156 | */\r | |
| 157 | \r | |
| 158 | case CLRO:\r | |
| 159 | h_write_o (spec, va, z_octa, acc); /* write 0's */\r | |
| 160 | CC_ZZ1P; /* set cc's */\r | |
| 161 | break;\r | |
| 162 | \r | |
| 163 | /* TSTH\r | |
| 164 | \r | |
| 165 | opnd[0:3] = src.rh\r | |
| 166 | */\r | |
| 167 | \r | |
| 168 | case TSTH:\r | |
| 169 | r = op_tsth (opnd[0]); /* test for 0 */\r | |
| 170 | CC_IIZZ_FP (r); /* set cc's */\r | |
| 171 | break;\r | |
| 172 | \r | |
| 173 | /* MOVO, MOVH, MNEGH\r | |
| 174 | \r | |
| 175 | opnd[0:3] = src.ro\r | |
| 176 | opnd[4:5] = dst.wo\r | |
| 177 | spec = last specifier\r | |
| 178 | va = address if last specifier is memory\r | |
| 179 | */\r | |
| 180 | \r | |
| 181 | case MOVO:\r | |
| 182 | h_write_o (spec, va, opnd, acc); /* write src */\r | |
| 183 | CC_IIZP_O (opnd[0], opnd[1], opnd[2], opnd[3]); /* set cc's */\r | |
| 184 | break;\r | |
| 185 | \r | |
| 186 | case MOVH:\r | |
| 187 | if (r = op_tsth (opnd[0])) { /* test for 0 */\r | |
| 188 | h_write_o (spec, va, opnd, acc); /* nz, write result */\r | |
| 189 | CC_IIZP_FP (r); /* set cc's */\r | |
| 190 | }\r | |
| 191 | else { /* zero */\r | |
| 192 | h_write_o (spec, va, z_octa, acc); /* write 0 */\r | |
| 193 | cc = (cc & CC_C) | CC_Z; /* set cc's */\r | |
| 194 | }\r | |
| 195 | break;\r | |
| 196 | \r | |
| 197 | case MNEGH:\r | |
| 198 | if (r = op_tsth (opnd[0])) { /* test for 0 */\r | |
| 199 | opnd[0] = opnd[0] ^ FPSIGN; /* nz, invert sign */\r | |
| 200 | h_write_o (spec, va, opnd, acc); /* write result */\r | |
| 201 | CC_IIZZ_FP (opnd[0]); /* set cc's */\r | |
| 202 | }\r | |
| 203 | else { /* zero */\r | |
| 204 | h_write_o (spec, va, z_octa, acc); /* write 0 */\r | |
| 205 | cc = CC_Z; /* set cc's */\r | |
| 206 | }\r | |
| 207 | break;\r | |
| 208 | \r | |
| 209 | /* CMPH\r | |
| 210 | \r | |
| 211 | opnd[0:3] = src1.rh\r | |
| 212 | opnd[4:7] = src2.rh\r | |
| 213 | */\r | |
| 214 | \r | |
| 215 | case CMPH:\r | |
| 216 | cc = op_cmph (opnd + 0, opnd + 4); /* set cc's */\r | |
| 217 | break;\r | |
| 218 | \r | |
| 219 | /* CVTBH, CVTWH, CVTLH\r | |
| 220 | \r | |
| 221 | opnd[0] = src.rx\r | |
| 222 | opnd[1:2] = dst.wh\r | |
| 223 | spec = last specifier\r | |
| 224 | va = address if last specifier is memory\r | |
| 225 | */\r | |
| 226 | \r | |
| 227 | case CVTBH:\r | |
| 228 | r = op_cvtih (SXTB (opnd[0]), r_octa); /* convert */\r | |
| 229 | h_write_o (spec, va, r_octa, acc); /* write reslt */\r | |
| 230 | CC_IIZZ_FP (r); /* set cc's */\r | |
| 231 | break;\r | |
| 232 | \r | |
| 233 | case CVTWH:\r | |
| 234 | r = op_cvtih (SXTW (opnd[0]), r_octa); /* convert */\r | |
| 235 | h_write_o (spec, va, r_octa, acc); /* write result */\r | |
| 236 | CC_IIZZ_FP (r); /* set cc's */\r | |
| 237 | break;\r | |
| 238 | \r | |
| 239 | case CVTLH:\r | |
| 240 | r = op_cvtih (opnd[0], r_octa); /* convert */\r | |
| 241 | h_write_o (spec, va, r_octa, acc); /* write result */\r | |
| 242 | CC_IIZZ_FP (r); /* set cc's */\r | |
| 243 | break;\r | |
| 244 | \r | |
| 245 | /* CVTHB, CVTHW, CVTHL, CVTRHL\r | |
| 246 | \r | |
| 247 | opnd[0:3] = src.rh\r | |
| 248 | opnd[4:5] = dst.wx\r | |
| 249 | spec = last specifier\r | |
| 250 | va = address if last specifier is memory\r | |
| 251 | */\r | |
| 252 | \r | |
| 253 | case CVTHB:\r | |
| 254 | r = op_cvthi (opnd, &flg, opc) & BMASK; /* convert */\r | |
| 255 | h_write_b (spec, va, r, acc); /* write result */\r | |
| 256 | CC_IIZZ_B (r); /* set cc's */\r | |
| 257 | if (flg) { V_INTOV; }\r | |
| 258 | break;\r | |
| 259 | \r | |
| 260 | case CVTHW:\r | |
| 261 | r = op_cvthi (opnd, &flg, opc) & WMASK; /* convert */\r | |
| 262 | h_write_w (spec, va, r, acc); /* write result */\r | |
| 263 | CC_IIZZ_W (r); /* set cc's */\r | |
| 264 | if (flg) { V_INTOV; }\r | |
| 265 | break;\r | |
| 266 | \r | |
| 267 | case CVTHL: case CVTRHL:\r | |
| 268 | r = op_cvthi (opnd, &flg, opc) & LMASK; /* convert */\r | |
| 269 | h_write_l (spec, va, r, acc); /* write result */\r | |
| 270 | CC_IIZZ_L (r); /* set cc's */\r | |
| 271 | if (flg) { V_INTOV; }\r | |
| 272 | break;\r | |
| 273 | \r | |
| 274 | /* CVTFH\r | |
| 275 | \r | |
| 276 | opnd[0] = src.rf\r | |
| 277 | opnd[1:2] = dst.wh\r | |
| 278 | spec = last specifier\r | |
| 279 | va = address if last specifier is memory\r | |
| 280 | */\r | |
| 281 | \r | |
| 282 | case CVTFH:\r | |
| 283 | r = op_cvtfdh (opnd[0], 0, r_octa); /* convert */\r | |
| 284 | h_write_o (spec, va, r_octa, acc); /* write result */\r | |
| 285 | CC_IIZZ_FP (r); /* set cc's */\r | |
| 286 | break;\r | |
| 287 | \r | |
| 288 | /* CVTDH, CVTGH\r | |
| 289 | \r | |
| 290 | opnd[0:1] = src.rx\r | |
| 291 | opnd[2:3] = dst.wh\r | |
| 292 | spec = last specifier\r | |
| 293 | va = address if last specifier is memory\r | |
| 294 | */\r | |
| 295 | \r | |
| 296 | case CVTDH:\r | |
| 297 | r = op_cvtfdh (opnd[0], opnd[1], r_octa); /* convert */\r | |
| 298 | h_write_o (spec, va, r_octa, acc); /* write result */\r | |
| 299 | CC_IIZZ_FP (r); /* set cc's */\r | |
| 300 | break;\r | |
| 301 | \r | |
| 302 | case CVTGH:\r | |
| 303 | r = op_cvtgh (opnd[0], opnd[1], r_octa); /* convert */\r | |
| 304 | h_write_o (spec, va, r_octa, acc); /* write result */\r | |
| 305 | CC_IIZZ_FP (r); /* set cc's */\r | |
| 306 | break;\r | |
| 307 | \r | |
| 308 | /* CVTHF, CVTHD, CVTHG\r | |
| 309 | \r | |
| 310 | opnd[0:3] = src.rh\r | |
| 311 | opnd[4:5] = dst.wx\r | |
| 312 | spec = last specifier\r | |
| 313 | va = address if last specifier is memory\r | |
| 314 | */\r | |
| 315 | \r | |
| 316 | case CVTHF:\r | |
| 317 | r = op_cvthfd (opnd, NULL); /* convert */\r | |
| 318 | h_write_l (spec, va, r, acc); /* write result */\r | |
| 319 | CC_IIZZ_FP (r); /* set cc's */\r | |
| 320 | break;\r | |
| 321 | \r | |
| 322 | case CVTHD:\r | |
| 323 | r = op_cvthfd (opnd, &rh); /* convert */\r | |
| 324 | h_write_q (spec, va, r, rh, acc); /* write result */\r | |
| 325 | CC_IIZZ_FP (r); /* set cc's */\r | |
| 326 | break;\r | |
| 327 | \r | |
| 328 | case CVTHG:\r | |
| 329 | r = op_cvthg (opnd, &rh); /* convert */\r | |
| 330 | h_write_q (spec, va, r, rh, acc); /* write result */\r | |
| 331 | CC_IIZZ_FP (r); /* set cc's */\r | |
| 332 | break;\r | |
| 333 | \r | |
| 334 | /* ADDH2, SUBH2, MULH2, DIVH2\r | |
| 335 | \r | |
| 336 | op[0:3] = src.rh\r | |
| 337 | op[4:7] = dst.mh\r | |
| 338 | spec = last specifier\r | |
| 339 | va = address if last specifier is memory\r | |
| 340 | \r | |
| 341 | ADDH3, SUBH3, MULH3, DIVH3\r | |
| 342 | \r | |
| 343 | op[0:3] = src1.rh\r | |
| 344 | op[4:7] = src2.rh\r | |
| 345 | op[8:9] = dst.wh\r | |
| 346 | spec = last specifier\r | |
| 347 | va = address if last specifier is memory\r | |
| 348 | */\r | |
| 349 | \r | |
| 350 | \r | |
| 351 | case ADDH2: case ADDH3:\r | |
| 352 | r = op_addh (opnd, r_octa, FALSE); /* add */\r | |
| 353 | h_write_o (spec, va, r_octa, acc); /* write result */\r | |
| 354 | CC_IIZZ_FP (r); /* set cc's */\r | |
| 355 | break;\r | |
| 356 | \r | |
| 357 | case SUBH2: case SUBH3:\r | |
| 358 | r = op_addh (opnd, r_octa, TRUE); /* subtract */\r | |
| 359 | h_write_o (spec, va, r_octa, acc); /* write result */\r | |
| 360 | CC_IIZZ_FP (r); /* set cc's */\r | |
| 361 | break;\r | |
| 362 | \r | |
| 363 | case MULH2: case MULH3:\r | |
| 364 | r = op_mulh (opnd, r_octa); /* multiply */\r | |
| 365 | h_write_o (spec, va, r_octa, acc); /* write result */\r | |
| 366 | CC_IIZZ_FP (r); /* set cc's */\r | |
| 367 | break;\r | |
| 368 | \r | |
| 369 | case DIVH2: case DIVH3:\r | |
| 370 | r = op_divh (opnd, r_octa); /* divide */\r | |
| 371 | h_write_o (spec, va, r_octa, acc); /* write result */\r | |
| 372 | CC_IIZZ_FP (r); /* set cc's */\r | |
| 373 | break;\r | |
| 374 | \r | |
| 375 | /* ACBH\r | |
| 376 | \r | |
| 377 | opnd[0:3] = limit.rh\r | |
| 378 | opnd[4:7] = add.rh\r | |
| 379 | opnd[8:11] = index.mh\r | |
| 380 | spec = last specifier\r | |
| 381 | va = last va\r | |
| 382 | brdest = branch destination\r | |
| 383 | */\r | |
| 384 | \r | |
| 385 | case ACBH:\r | |
| 386 | r = op_addh (opnd + 4, r_octa, FALSE); /* add + index */\r | |
| 387 | CC_IIZP_FP (r); /* set cc's */\r | |
| 388 | temp = op_cmph (r_octa, opnd); /* result : limit */\r | |
| 389 | h_write_o (spec, va, r_octa, acc); /* write 2nd */\r | |
| 390 | if ((temp & CC_Z) || ((opnd[4] & FPSIGN)? /* test br cond */\r | |
| 391 | !(temp & CC_N): (temp & CC_N)))\r | |
| 392 | cc = cc | LSIGN; /* hack for branch */\r | |
| 393 | break;\r | |
| 394 | \r | |
| 395 | /* POLYH\r | |
| 396 | \r | |
| 397 | opnd[0:3] = arg.rh\r | |
| 398 | opnd[4] = deg.rb\r | |
| 399 | opnd[5] = table.ah\r | |
| 400 | */\r | |
| 401 | \r | |
| 402 | case POLYH:\r | |
| 403 | op_polyh (opnd, acc); /* eval polynomial */\r | |
| 404 | CC_IIZZ_FP (R[0]); /* set cc's */\r | |
| 405 | break;\r | |
| 406 | \r | |
| 407 | /* EMODH\r | |
| 408 | \r | |
| 409 | opnd[0:3] = multiplier\r | |
| 410 | opnd[4] = extension\r | |
| 411 | opnd[5:8] = multiplicand\r | |
| 412 | opnd[9:10] = integer destination (int.wl)\r | |
| 413 | opnd[11:12] = floating destination (flt.wh)\r | |
| 414 | spec = last specifier\r | |
| 415 | va = address if last specifier is memory\r | |
| 416 | */\r | |
| 417 | \r | |
| 418 | case EMODH:\r | |
| 419 | r = op_emodh (opnd, r_octa, &temp, &flg); /* extended mod */\r | |
| 420 | if (opnd[11] < 0) { /* 2nd memory? */\r | |
| 421 | Read (opnd[12], L_BYTE, WA); /* prove write */\r | |
| 422 | Read ((opnd[12] + 15) & LMASK, L_BYTE, WA);\r | |
| 423 | }\r | |
| 424 | if (opnd[9] >= 0) R[opnd[9]] = temp; /* store 1st */\r | |
| 425 | else Write (opnd[10], temp, L_LONG, WA);\r | |
| 426 | h_write_o (spec, va, r_octa, acc); /* write 2nd */\r | |
| 427 | CC_IIZZ_FP (r); /* set cc's */\r | |
| 428 | if (flg) { V_INTOV; } /* int ovflo? */\r | |
| 429 | break;\r | |
| 430 | \r | |
| 431 | default:\r | |
| 432 | RSVD_INST_FAULT;\r | |
| 433 | }\r | |
| 434 | \r | |
| 435 | return cc;\r | |
| 436 | }\r | |
| 437 | \r | |
| 438 | /* Test h_floating\r | |
| 439 | \r | |
| 440 | Note that only the high 32b is processed.\r | |
| 441 | If the high 32b is not zero, the rest of the fraction is unchanged. */\r | |
| 442 | \r | |
| 443 | int32 op_tsth (int32 val)\r | |
| 444 | {\r | |
| 445 | if (val & H_EXP) return val; /* non-zero? */\r | |
| 446 | if (val & FPSIGN) RSVD_OPND_FAULT; /* reserved? */\r | |
| 447 | return 0; /* clean 0 */\r | |
| 448 | }\r | |
| 449 | \r | |
| 450 | /* Compare h_floating */\r | |
| 451 | \r | |
| 452 | int32 op_cmph (int32 *hf1, int32 *hf2)\r | |
| 453 | {\r | |
| 454 | UFPH a, b;\r | |
| 455 | int32 r;\r | |
| 456 | \r | |
| 457 | h_unpackh (hf1, &a); /* unpack op1 */\r | |
| 458 | h_unpackh (hf2, &b); /* unpack op2 */\r | |
| 459 | if (a.sign != b.sign) return (a.sign? CC_N: 0); /* opp signs? */\r | |
| 460 | if (a.exp != b.exp) r = a.exp - b.exp; /* cmp exp */\r | |
| 461 | else r = qp_cmp (&a.frac, &b.frac); /* if =, cmp frac */\r | |
| 462 | if (r < 0) return (a.sign? 0: CC_N); /* !=, maybe set N */\r | |
| 463 | if (r > 0) return (a.sign? CC_N: 0);\r | |
| 464 | return CC_Z; /* =, set Z */\r | |
| 465 | }\r | |
| 466 | \r | |
| 467 | /* Integer to h_floating convert */\r | |
| 468 | \r | |
| 469 | int32 op_cvtih (int32 val, int32 *hf)\r | |
| 470 | {\r | |
| 471 | UFPH a;\r | |
| 472 | \r | |
| 473 | if (val == 0) { /* zero? */\r | |
| 474 | hf[0] = hf[1] = hf[2] = hf[3] = 0; /* result is 0 */\r | |
| 475 | return 0;\r | |
| 476 | }\r | |
| 477 | if (val < 0) { /* negative? */\r | |
| 478 | a.sign = FPSIGN; /* sign = - */\r | |
| 479 | val = -val;\r | |
| 480 | }\r | |
| 481 | else a.sign = 0; /* else sign = + */\r | |
| 482 | a.exp = 32 + H_BIAS; /* initial exp */\r | |
| 483 | a.frac.f3 = val & LMASK; /* fraction hi */\r | |
| 484 | a.frac.f2 = a.frac.f1 = a.frac.f0 = 0;\r | |
| 485 | h_normh (&a); /* normalize */\r | |
| 486 | return h_rpackh (&a, hf); /* round and pack */\r | |
| 487 | }\r | |
| 488 | \r | |
| 489 | /* H_floating to integer convert */\r | |
| 490 | \r | |
| 491 | int32 op_cvthi (int32 *hf, int32 *flg, int32 opc)\r | |
| 492 | {\r | |
| 493 | UFPH a;\r | |
| 494 | int32 lnt = opc & 03;\r | |
| 495 | int32 ubexp;\r | |
| 496 | static uint32 maxv[4] = { 0x7F, 0x7FFF, 0x7FFFFFFF, 0x7FFFFFFF };\r | |
| 497 | \r | |
| 498 | *flg = 0; /* clear ovflo */\r | |
| 499 | h_unpackh (hf, &a); /* unpack */\r | |
| 500 | ubexp = a.exp - H_BIAS; /* unbiased exp */\r | |
| 501 | if ((a.exp == 0) || (ubexp < 0)) return 0; /* true zero or frac? */\r | |
| 502 | if (ubexp <= UH_V_NM) { /* exp in range? */\r | |
| 503 | qp_rsh (&a.frac, UH_V_NM - ubexp); /* leave rnd bit */\r | |
| 504 | if (lnt == 03) qp_inc (&a.frac); /* if CVTR, round */\r | |
| 505 | qp_rsh (&a.frac, 1); /* now justified */\r | |
| 506 | if (a.frac.f3 || a.frac.f2 || a.frac.f1 ||\r | |
| 507 | (a.frac.f0 > (maxv[lnt] + (a.sign? 1: 0)))) *flg = CC_V;\r | |
| 508 | }\r | |
| 509 | else {\r | |
| 510 | *flg = CC_V; /* always ovflo */\r | |
| 511 | if (ubexp > (UH_V_NM + 32)) return 0; /* in ext range? */\r | |
| 512 | qp_lsh (&a.frac, ubexp - UH_V_NM - 1); /* no rnd bit */\r | |
| 513 | }\r | |
| 514 | return (a.sign? NEG (a.frac.f0): a.frac.f0); /* return lo frac */\r | |
| 515 | }\r | |
| 516 | \r | |
| 517 | /* Floating to floating convert - F/D to H, G to H, H to F/D, H to G */\r | |
| 518 | \r | |
| 519 | int32 op_cvtfdh (int32 vl, int32 vh, int32 *hflt)\r | |
| 520 | {\r | |
| 521 | UFPH a;\r | |
| 522 | \r | |
| 523 | h_unpackfd (vl, vh, &a); /* unpack f/d */\r | |
| 524 | a.exp = a.exp - FD_BIAS + H_BIAS; /* if nz, adjust exp */\r | |
| 525 | return h_rpackh (&a, hflt); /* round and pack */\r | |
| 526 | }\r | |
| 527 | \r | |
| 528 | int32 op_cvtgh (int32 vl, int32 vh, int32 *hflt)\r | |
| 529 | {\r | |
| 530 | UFPH a;\r | |
| 531 | \r | |
| 532 | h_unpackg (vl, vh, &a); /* unpack g */\r | |
| 533 | a.exp = a.exp - G_BIAS + H_BIAS; /* if nz, adjust exp */\r | |
| 534 | return h_rpackh (&a, hflt); /* round and pack */\r | |
| 535 | }\r | |
| 536 | \r | |
| 537 | int32 op_cvthfd (int32 *hflt, int32 *rh)\r | |
| 538 | {\r | |
| 539 | UFPH a;\r | |
| 540 | \r | |
| 541 | h_unpackh (hflt, &a); /* unpack h */\r | |
| 542 | a.exp = a.exp - H_BIAS + FD_BIAS; /* if nz, adjust exp */\r | |
| 543 | return h_rpackfd (&a, rh); /* round and pack */\r | |
| 544 | }\r | |
| 545 | \r | |
| 546 | int32 op_cvthg (int32 *hflt, int32 *rh)\r | |
| 547 | {\r | |
| 548 | UFPH a;\r | |
| 549 | \r | |
| 550 | h_unpackh (hflt, &a); /* unpack h */\r | |
| 551 | a.exp = a.exp - H_BIAS + G_BIAS; /* if nz, adjust exp */\r | |
| 552 | return h_rpackg (&a, rh); /* round and pack */\r | |
| 553 | }\r | |
| 554 | \r | |
| 555 | /* Floating add and subtract */\r | |
| 556 | \r | |
| 557 | int32 op_addh (int32 *opnd, int32 *hflt, t_bool sub)\r | |
| 558 | {\r | |
| 559 | UFPH a, b;\r | |
| 560 | \r | |
| 561 | h_unpackh (&opnd[0], &a); /* unpack s1, s2 */\r | |
| 562 | h_unpackh (&opnd[4], &b);\r | |
| 563 | if (sub) a.sign = a.sign ^ FPSIGN; /* sub? -s1 */\r | |
| 564 | vax_hadd (&a, &b); /* do add */\r | |
| 565 | return h_rpackh (&a, hflt); /* round and pack */\r | |
| 566 | }\r | |
| 567 | \r | |
| 568 | /* Floating multiply */\r | |
| 569 | \r | |
| 570 | int32 op_mulh (int32 *opnd, int32 *hflt)\r | |
| 571 | {\r | |
| 572 | UFPH a, b;\r | |
| 573 | \r | |
| 574 | h_unpackh (&opnd[0], &a); /* unpack s1, s2 */\r | |
| 575 | h_unpackh (&opnd[4], &b);\r | |
| 576 | vax_hmul (&a, &b, 0); /* do multiply */\r | |
| 577 | return h_rpackh (&a, hflt); /* round and pack */\r | |
| 578 | }\r | |
| 579 | \r | |
| 580 | /* Floating divide */\r | |
| 581 | \r | |
| 582 | int32 op_divh (int32 *opnd, int32 *hflt)\r | |
| 583 | {\r | |
| 584 | UFPH a, b;\r | |
| 585 | \r | |
| 586 | h_unpackh (&opnd[0], &a); /* unpack s1, s2 */\r | |
| 587 | h_unpackh (&opnd[4], &b);\r | |
| 588 | vax_hdiv (&a, &b); /* do divide */\r | |
| 589 | return h_rpackh (&b, hflt); /* round and pack */\r | |
| 590 | }\r | |
| 591 | \r | |
| 592 | /* Polynomial evaluation\r | |
| 593 | \r | |
| 594 | The most mis-implemented instruction in the VAX (probably here too).\r | |
| 595 | POLY requires a precise combination of masking versus normalizing\r | |
| 596 | to achieve the desired answer. In particular, both the multiply\r | |
| 597 | and add steps are masked prior to normalization. In addition,\r | |
| 598 | negative small fractions must not be treated as 0 during denorm. */\r | |
| 599 | \r | |
| 600 | void op_polyh (int32 *opnd, int32 acc)\r | |
| 601 | {\r | |
| 602 | UFPH r, a, c;\r | |
| 603 | int32 deg = opnd[4];\r | |
| 604 | int32 ptr = opnd[5];\r | |
| 605 | int32 i, wd[4], res[4];\r | |
| 606 | \r | |
| 607 | if (deg > 31) RSVD_OPND_FAULT; /* deg > 31? fault */\r | |
| 608 | h_unpackh (&opnd[0], &a); /* unpack arg */\r | |
| 609 | wd[0] = Read (ptr, L_LONG, RD); /* get C0 */\r | |
| 610 | wd[1] = Read (ptr + 4, L_LONG, RD);\r | |
| 611 | wd[2] = Read (ptr + 8, L_LONG, RD);\r | |
| 612 | wd[3] = Read (ptr + 12, L_LONG, RD);\r | |
| 613 | ptr = ptr + 16; /* adv ptr */\r | |
| 614 | h_unpackh (wd, &r); /* unpack C0 */\r | |
| 615 | h_rpackh (&r, res); /* first result */\r | |
| 616 | for (i = 0; i < deg; i++) { /* loop */\r | |
| 617 | h_unpackh (res, &r); /* unpack result */\r | |
| 618 | vax_hmul (&r, &a, 1); /* r = r * arg */\r | |
| 619 | wd[0] = Read (ptr, L_LONG, RD); /* get Cn */\r | |
| 620 | wd[1] = Read (ptr + 4, L_LONG, RD);\r | |
| 621 | wd[2] = Read (ptr + 8, L_LONG, RD);\r | |
| 622 | wd[3] = Read (ptr + 12, L_LONG, RD);\r | |
| 623 | ptr = ptr + 16;\r | |
| 624 | h_unpackh (wd, &c); /* unpack Cnext */\r | |
| 625 | vax_hadd (&r, &c); /* r = r + Cnext */\r | |
| 626 | h_rpackh (&r, res); /* round and pack */\r | |
| 627 | }\r | |
| 628 | R[0] = res[0]; /* result */\r | |
| 629 | R[1] = res[1];\r | |
| 630 | R[2] = res[2];\r | |
| 631 | R[3] = res[3];\r | |
| 632 | R[4] = 0;\r | |
| 633 | R[5] = ptr;\r | |
| 634 | return;\r | |
| 635 | }\r | |
| 636 | \r | |
| 637 | /* Extended modularize\r | |
| 638 | \r | |
| 639 | EMOD presents two sets of complications. First, it requires an extended\r | |
| 640 | fraction multiply, with precise (and unusual) truncation conditions.\r | |
| 641 | Second, it has two write operands, a dubious distinction it shares\r | |
| 642 | with EDIV. */\r | |
| 643 | \r | |
| 644 | int32 op_emodh (int32 *opnd, int32 *hflt, int32 *intgr, int32 *flg)\r | |
| 645 | {\r | |
| 646 | UFPH a, b;\r | |
| 647 | \r | |
| 648 | h_unpackh (&opnd[0], &a); /* unpack operands */\r | |
| 649 | h_unpackh (&opnd[5], &b);\r | |
| 650 | a.frac.f0 = a.frac.f0 | (opnd[4] >> 1); /* extend src1 */\r | |
| 651 | vax_hmul (&a, &b, 0); /* multiply */\r | |
| 652 | vax_hmod (&a, intgr, flg); /* sep int & frac */\r | |
| 653 | return h_rpackh (&a, hflt); /* round and pack frac */\r | |
| 654 | }\r | |
| 655 | \r | |
| 656 | /* Unpacked floating point routines */\r | |
| 657 | \r | |
| 658 | /* Floating add */\r | |
| 659 | \r | |
| 660 | void vax_hadd (UFPH *a, UFPH *b)\r | |
| 661 | {\r | |
| 662 | int32 ediff;\r | |
| 663 | UFPH t;\r | |
| 664 | \r | |
| 665 | if ((a->frac.f3 == 0) && (a->frac.f2 == 0) && /* s1 = 0? */\r | |
| 666 | (a->frac.f1 == 0) && (a->frac.f0 == 0)) {\r | |
| 667 | *a = *b; /* result is s2 */\r | |
| 668 | return;\r | |
| 669 | }\r | |
| 670 | if ((b->frac.f3 == 0) && (b->frac.f2 == 0) && /* s2 = 0? */\r | |
| 671 | (b->frac.f1 == 0) && (b->frac.f0 == 0))\r | |
| 672 | return;\r | |
| 673 | if ((a->exp < b->exp) || /* |s1| < |s2|? */\r | |
| 674 | ((a->exp == b->exp) && (qp_cmp (&a->frac, &b->frac) < 0))) {\r | |
| 675 | t = *a; /* swap */\r | |
| 676 | *a = *b;\r | |
| 677 | *b = t;\r | |
| 678 | }\r | |
| 679 | ediff = a->exp - b->exp; /* exp diff */\r | |
| 680 | if (a->sign ^ b->sign) { /* eff sub? */\r | |
| 681 | qp_neg (&b->frac); /* negate fraction */\r | |
| 682 | if (ediff) qp_rsh_s (&b->frac, ediff, 1); /* denormalize */\r | |
| 683 | qp_add (&a->frac, &b->frac); /* "add" frac */\r | |
| 684 | h_normh (a); /* normalize */\r | |
| 685 | }\r | |
| 686 | else {\r | |
| 687 | if (ediff) qp_rsh (&b->frac, ediff); /* add, denormalize */\r | |
| 688 | if (qp_add (&a->frac, &b->frac)) { /* add frac, carry? */\r | |
| 689 | qp_rsh (&a->frac, 1); /* renormalize */\r | |
| 690 | a->frac.f3 = a->frac.f3 | UH_NM_H; /* add norm bit */\r | |
| 691 | a->exp = a->exp + 1; /* incr exp */\r | |
| 692 | }\r | |
| 693 | }\r | |
| 694 | return;\r | |
| 695 | }\r | |
| 696 | \r | |
| 697 | /* Floating multiply - 128b * 128b */\r | |
| 698 | \r | |
| 699 | void vax_hmul (UFPH *a, UFPH *b, uint32 mlo)\r | |
| 700 | {\r | |
| 701 | int32 i, c;\r | |
| 702 | UQP accum = { 0, 0, 0, 0 };\r | |
| 703 | \r | |
| 704 | if ((a->exp == 0) || (b->exp == 0)) { /* zero argument? */\r | |
| 705 | a->frac.f0 = a->frac.f1 = 0; /* result is zero */\r | |
| 706 | a->frac.f2 = a->frac.f3 = 0;\r | |
| 707 | a->sign = a->exp = 0;\r | |
| 708 | return;\r | |
| 709 | }\r | |
| 710 | a->sign = a->sign ^ b->sign; /* sign of result */\r | |
| 711 | a->exp = a->exp + b->exp - H_BIAS; /* add exponents */\r | |
| 712 | for (i = 0; i < 128; i++) { /* quad precision */\r | |
| 713 | if (a->frac.f0 & 1) c = qp_add (&accum, &b->frac); /* mplr low? add */\r | |
| 714 | else c = 0;\r | |
| 715 | qp_rsh (&accum, 1); /* shift result */\r | |
| 716 | if (c) accum.f3 = accum.f3 | UH_NM_H; /* add carry out */\r | |
| 717 | qp_rsh (&a->frac, 1); /* shift mplr */\r | |
| 718 | }\r | |
| 719 | a->frac = accum; /* result */\r | |
| 720 | a->frac.f0 = a->frac.f0 & ~mlo; /* mask low frac */\r | |
| 721 | h_normh (a); /* normalize */\r | |
| 722 | return;\r | |
| 723 | }\r | |
| 724 | \r | |
| 725 | /* Floating modulus - there are three cases\r | |
| 726 | \r | |
| 727 | exp <= bias - integer is 0, fraction is input,\r | |
| 728 | no overflow\r | |
| 729 | bias < exp <= bias+128 - separate integer and fraction,\r | |
| 730 | integer overflow may occur\r | |
| 731 | bias+128 < exp - result is integer, fraction is 0\r | |
| 732 | integer overflow\r | |
| 733 | */\r | |
| 734 | \r | |
| 735 | void vax_hmod (UFPH *a, int32 *intgr, int32 *flg)\r | |
| 736 | {\r | |
| 737 | UQP ifr;\r | |
| 738 | \r | |
| 739 | if (a->exp <= H_BIAS) *intgr = *flg = 0; /* 0 or <1? int = 0 */\r | |
| 740 | else if (a->exp <= (H_BIAS + 128)) { /* in range? */\r | |
| 741 | ifr = a->frac;\r | |
| 742 | qp_rsh (&ifr, 128 - (a->exp - H_BIAS)); /* separate integer */\r | |
| 743 | if ((a->exp > (H_BIAS + 32)) || /* test ovflo */\r | |
| 744 | ((a->exp == (H_BIAS + 32)) &&\r | |
| 745 | (ifr.f0 > (a->sign? 0x80000000: 0x7FFFFFFF))))\r | |
| 746 | *flg = CC_V;\r | |
| 747 | else *flg = 0;\r | |
| 748 | *intgr = ifr.f0;\r | |
| 749 | if (a->sign) *intgr = -*intgr; /* -? comp int */\r | |
| 750 | qp_lsh (&a->frac, a->exp - H_BIAS); /* excise integer */\r | |
| 751 | a->exp = H_BIAS;\r | |
| 752 | }\r | |
| 753 | else {\r | |
| 754 | *intgr = 0; /* out of range */\r | |
| 755 | a->frac.f0 = a->frac.f1 = 0; /* result 0 */\r | |
| 756 | a->frac.f2 = a->frac.f3 = 0;\r | |
| 757 | a->sign = a->exp = 0;\r | |
| 758 | *flg = CC_V; /* overflow */\r | |
| 759 | }\r | |
| 760 | h_normh (a); /* normalize */\r | |
| 761 | return;\r | |
| 762 | }\r | |
| 763 | \r | |
| 764 | /* Floating divide\r | |
| 765 | \r | |
| 766 | Carried out to 128 bits, although fewer are required */\r | |
| 767 | \r | |
| 768 | void vax_hdiv (UFPH *a, UFPH *b)\r | |
| 769 | {\r | |
| 770 | int32 i;\r | |
| 771 | UQP quo = { 0, 0, 0, 0 };\r | |
| 772 | \r | |
| 773 | if (a->exp == 0) FLT_DZRO_FAULT; /* divr = 0? */\r | |
| 774 | if (b->exp == 0) return; /* divd = 0? */\r | |
| 775 | b->sign = b->sign ^ a->sign; /* result sign */\r | |
| 776 | b->exp = b->exp - a->exp + H_BIAS + 1; /* unbiased exp */\r | |
| 777 | qp_rsh (&a->frac, 1); /* allow 1 bit left */\r | |
| 778 | qp_rsh (&b->frac, 1);\r | |
| 779 | for (i = 0; i < 128; i++) { /* divide loop */\r | |
| 780 | qp_lsh (&quo, 1); /* shift quo */\r | |
| 781 | if (qp_cmp (&b->frac, &a->frac) >= 0) { /* div step ok? */\r | |
| 782 | qp_sub (&b->frac, &a->frac); /* subtract */\r | |
| 783 | quo.f0 = quo.f0 + 1; /* quo bit = 1 */\r | |
| 784 | }\r | |
| 785 | qp_lsh (&b->frac, 1); /* shift divd */\r | |
| 786 | }\r | |
| 787 | b->frac = quo;\r | |
| 788 | h_normh (b); /* normalize */\r | |
| 789 | return;\r | |
| 790 | }\r | |
| 791 | \r | |
| 792 | /* Quad precision integer routines */\r | |
| 793 | \r | |
| 794 | int32 qp_cmp (UQP *a, UQP *b)\r | |
| 795 | {\r | |
| 796 | if (a->f3 < b->f3) return -1; /* compare hi */\r | |
| 797 | if (a->f3 > b->f3) return +1;\r | |
| 798 | if (a->f2 < b->f2) return -1; /* hi =, compare mid1 */\r | |
| 799 | if (a->f2 > b->f2) return +1;\r | |
| 800 | if (a->f1 < b->f1) return -1; /* mid1 =, compare mid2 */\r | |
| 801 | if (a->f1 > b->f1) return +1;\r | |
| 802 | if (a->f0 < b->f0) return -1; /* mid2 =, compare lo */\r | |
| 803 | if (a->f0 > b->f0) return +1;\r | |
| 804 | return 0; /* all equal */\r | |
| 805 | }\r | |
| 806 | \r | |
| 807 | uint32 qp_add (UQP *a, UQP *b)\r | |
| 808 | {\r | |
| 809 | uint32 cry1, cry2, cry3, cry4;\r | |
| 810 | \r | |
| 811 | a->f0 = (a->f0 + b->f0) & LMASK; /* add lo */\r | |
| 812 | cry1 = (a->f0 < b->f0); /* carry? */\r | |
| 813 | a->f1 = (a->f1 + b->f1 + cry1) & LMASK; /* add mid2 */\r | |
| 814 | cry2 = (a->f1 < b->f1) || (cry1 && (a->f1 == b->f1)); /* carry? */\r | |
| 815 | a->f2 = (a->f2 + b->f2 + cry2) & LMASK; /* add mid1 */\r | |
| 816 | cry3 = (a->f2 < b->f2) || (cry2 && (a->f2 == b->f2)); /* carry? */\r | |
| 817 | a->f3 = (a->f3 + b->f3 + cry3) & LMASK; /* add hi */\r | |
| 818 | cry4 = (a->f3 < b->f3) || (cry3 && (a->f3 == b->f3)); /* carry? */\r | |
| 819 | return cry4; /* return carry out */\r | |
| 820 | }\r | |
| 821 | \r | |
| 822 | void qp_inc (UQP *a)\r | |
| 823 | {\r | |
| 824 | a->f0 = (a->f0 + 1) & LMASK; /* inc lo */\r | |
| 825 | if (a->f0 == 0) { /* propagate carry */\r | |
| 826 | a->f1 = (a->f1 + 1) & LMASK;\r | |
| 827 | if (a->f1 == 0) {\r | |
| 828 | a->f2 = (a->f2 + 1) & LMASK;\r | |
| 829 | if (a->f2 == 0) {\r | |
| 830 | a->f3 = (a->f3 + 1) & LMASK;\r | |
| 831 | }\r | |
| 832 | }\r | |
| 833 | }\r | |
| 834 | return;\r | |
| 835 | }\r | |
| 836 | \r | |
| 837 | uint32 qp_sub (UQP *a, UQP *b)\r | |
| 838 | {\r | |
| 839 | uint32 brw1, brw2, brw3, brw4;\r | |
| 840 | \r | |
| 841 | brw1 = (a->f0 < b->f0); /* borrow? */\r | |
| 842 | a->f0 = (a->f0 - b->f0) & LMASK; /* sub lo */\r | |
| 843 | brw2 = (a->f1 < b->f1) || (brw1 && (a->f1 == b->f1)); /* borrow? */\r | |
| 844 | a->f1 = (a->f1 - b->f1 - brw1) & LMASK; /* sub mid1 */\r | |
| 845 | brw3 = (a->f2 < b->f2) || (brw2 && (a->f2 == b->f2)); /* borrow? */\r | |
| 846 | a->f2 = (a->f2 - b->f2 - brw2) & LMASK; /* sub mid2 */\r | |
| 847 | brw4 = (a->f3 < b->f3) || (brw3 && (a->f3 == b->f3)); /* borrow? */\r | |
| 848 | a->f3 = (a->f3 - b->f3 - brw3) & LMASK; /* sub high */\r | |
| 849 | return brw4;\r | |
| 850 | }\r | |
| 851 | \r | |
| 852 | void qp_neg (UQP *a)\r | |
| 853 | {\r | |
| 854 | uint32 cryin;\r | |
| 855 | \r | |
| 856 | cryin = 1;\r | |
| 857 | a->f0 = (~a->f0 + cryin) & LMASK;\r | |
| 858 | if (a->f0 != 0) cryin = 0;\r | |
| 859 | a->f1 = (~a->f1 + cryin) & LMASK;\r | |
| 860 | if (a->f1 != 0) cryin = 0;\r | |
| 861 | a->f2 = (~a->f2 + cryin) & LMASK;\r | |
| 862 | if (a->f2 != 0) cryin = 0;\r | |
| 863 | a->f3 = (~a->f3 + cryin) & LMASK;\r | |
| 864 | return;\r | |
| 865 | }\r | |
| 866 | \r | |
| 867 | void qp_lsh (UQP *r, uint32 sc)\r | |
| 868 | {\r | |
| 869 | if (sc >= 128) r->f3 = r->f2 = r->f1 = r->f0 = 0; /* > 127? result 0 */\r | |
| 870 | else if (sc >= 96) { /* [96,127]? */\r | |
| 871 | r->f3 = (r->f0 << (sc - 96)) & LMASK;\r | |
| 872 | r->f2 = r->f1 = r->f0 = 0;\r | |
| 873 | }\r | |
| 874 | else if (sc > 64) { /* [65,95]? */\r | |
| 875 | r->f3 = ((r->f1 << (sc - 64)) | (r->f0 >> (96 - sc))) & LMASK;\r | |
| 876 | r->f2 = (r->f0 << (sc - 64)) & LMASK;\r | |
| 877 | r->f1 = r->f0 = 0;\r | |
| 878 | }\r | |
| 879 | else if (sc == 64) { /* [64]? */\r | |
| 880 | r->f3 = r->f1;\r | |
| 881 | r->f2 = r->f0;\r | |
| 882 | r->f1 = r->f0 = 0;\r | |
| 883 | }\r | |
| 884 | else if (sc > 32) { /* [33,63]? */\r | |
| 885 | r->f3 = ((r->f2 << (sc - 32)) | (r->f1 >> (64 - sc))) & LMASK;\r | |
| 886 | r->f2 = ((r->f1 << (sc - 32)) | (r->f0 >> (64 - sc))) & LMASK;\r | |
| 887 | r->f1 = (r->f0 << (sc - 32)) & LMASK;\r | |
| 888 | r->f0 = 0;\r | |
| 889 | }\r | |
| 890 | else if (sc == 32) { /* [32]? */\r | |
| 891 | r->f3 = r->f2;\r | |
| 892 | r->f2 = r->f1;\r | |
| 893 | r->f1 = r->f0;\r | |
| 894 | r->f0 = 0;\r | |
| 895 | }\r | |
| 896 | else if (sc != 0) { /* [31,1]? */\r | |
| 897 | r->f3 = ((r->f3 << sc) | (r->f2 >> (32 - sc))) & LMASK;\r | |
| 898 | r->f2 = ((r->f2 << sc) | (r->f1 >> (32 - sc))) & LMASK;\r | |
| 899 | r->f1 = ((r->f1 << sc) | (r->f0 >> (32 - sc))) & LMASK;\r | |
| 900 | r->f0 = (r->f0 << sc) & LMASK;\r | |
| 901 | }\r | |
| 902 | return;\r | |
| 903 | }\r | |
| 904 | \r | |
| 905 | void qp_rsh (UQP *r, uint32 sc)\r | |
| 906 | {\r | |
| 907 | if (sc >= 128) r->f3 = r->f2 = r->f1 = r->f0 = 0; /* > 127? result 0 */\r | |
| 908 | else if (sc >= 96) { /* [96,127]? */\r | |
| 909 | r->f0 = (r->f3 >> (sc - 96)) & LMASK;\r | |
| 910 | r->f1 = r->f2 = r->f3 = 0;\r | |
| 911 | }\r | |
| 912 | else if (sc > 64) { /* [65,95]? */\r | |
| 913 | r->f0 = ((r->f2 >> (sc - 64)) | (r->f3 << (96 - sc))) & LMASK;\r | |
| 914 | r->f1 = (r->f3 >> (sc - 64)) & LMASK;\r | |
| 915 | r->f2 = r->f3 = 0;\r | |
| 916 | }\r | |
| 917 | else if (sc == 64) { /* [64]? */\r | |
| 918 | r->f0 = r->f2;\r | |
| 919 | r->f1 = r->f3;\r | |
| 920 | r->f2 = r->f3 = 0;\r | |
| 921 | }\r | |
| 922 | else if (sc > 32) { /* [33,63]? */\r | |
| 923 | r->f0 = ((r->f1 >> (sc - 32)) | (r->f2 << (64 - sc))) & LMASK;\r | |
| 924 | r->f1 = ((r->f2 >> (sc - 32)) | (r->f3 << (64 - sc))) & LMASK;\r | |
| 925 | r->f2 = (r->f3 >> (sc - 32)) & LMASK;\r | |
| 926 | r->f3 = 0;\r | |
| 927 | }\r | |
| 928 | else if (sc == 32) { /* [32]? */\r | |
| 929 | r->f0 = r->f1;\r | |
| 930 | r->f1 = r->f2;\r | |
| 931 | r->f2 = r->f3;\r | |
| 932 | r->f3 = 0;\r | |
| 933 | }\r | |
| 934 | else if (sc != 0) { /* [31,1]? */\r | |
| 935 | r->f0 = ((r->f0 >> sc) | (r->f1 << (32 - sc))) & LMASK;\r | |
| 936 | r->f1 = ((r->f1 >> sc) | (r->f2 << (32 - sc))) & LMASK;\r | |
| 937 | r->f2 = ((r->f2 >> sc) | (r->f3 << (32 - sc))) & LMASK;\r | |
| 938 | r->f3 = (r->f3 >> sc) & LMASK;\r | |
| 939 | }\r | |
| 940 | return;\r | |
| 941 | }\r | |
| 942 | \r | |
| 943 | void qp_rsh_s (UQP *r, uint32 sc, uint32 neg)\r | |
| 944 | {\r | |
| 945 | qp_rsh (r, sc); /* do unsigned right */\r | |
| 946 | if (neg && sc) { /* negative? */\r | |
| 947 | if (sc >= 128)\r | |
| 948 | r->f0 = r->f1 = r->f2 = r->f3 = LMASK; /* > 127? result -1 */\r | |
| 949 | else {\r | |
| 950 | UQP ones = { LMASK, LMASK, LMASK, LMASK };\r | |
| 951 | qp_lsh (&ones, 128 - sc); /* shift ones */\r | |
| 952 | r->f0 = r->f0 | ones.f0; /* or into result */\r | |
| 953 | r->f1 = r->f1 | ones.f1;\r | |
| 954 | r->f2 = r->f2 | ones.f2;\r | |
| 955 | r->f3 = r->f3 | ones.f3;\r | |
| 956 | }\r | |
| 957 | }\r | |
| 958 | return;\r | |
| 959 | }\r | |
| 960 | \r | |
| 961 | /* Support routines */\r | |
| 962 | \r | |
| 963 | void h_unpackfd (int32 hi, int32 lo, UFPH *r)\r | |
| 964 | {\r | |
| 965 | r->sign = hi & FPSIGN; /* get sign */\r | |
| 966 | r->exp = FD_GETEXP (hi); /* get exponent */\r | |
| 967 | r->frac.f0 = r->frac.f1 = 0; /* low bits 0 */\r | |
| 968 | if (r->exp == 0) { /* exp = 0? */\r | |
| 969 | if (r->sign) RSVD_OPND_FAULT; /* if -, rsvd op */\r | |
| 970 | r->frac.f2 = r->frac.f3 = 0; /* else 0 */\r | |
| 971 | return;\r | |
| 972 | }\r | |
| 973 | r->frac.f3 = WORDSWAP ((hi & ~(FPSIGN | FD_EXP)) | FD_HB);\r | |
| 974 | r->frac.f2 = WORDSWAP (lo);\r | |
| 975 | qp_lsh (&r->frac, FD_GUARD);\r | |
| 976 | return;\r | |
| 977 | }\r | |
| 978 | \r | |
| 979 | void h_unpackg (int32 hi, int32 lo, UFPH *r)\r | |
| 980 | {\r | |
| 981 | r->sign = hi & FPSIGN; /* get sign */\r | |
| 982 | r->exp = G_GETEXP (hi); /* get exponent */\r | |
| 983 | r->frac.f0 = r->frac.f1 = 0; /* low bits 0 */\r | |
| 984 | if (r->exp == 0) { /* exp = 0? */\r | |
| 985 | if (r->sign) RSVD_OPND_FAULT; /* if -, rsvd op */\r | |
| 986 | r->frac.f2 = r->frac.f3 = 0; /* else 0 */\r | |
| 987 | return;\r | |
| 988 | }\r | |
| 989 | r->frac.f3 = WORDSWAP ((hi & ~(FPSIGN | G_EXP)) | G_HB);\r | |
| 990 | r->frac.f2 = WORDSWAP (lo);\r | |
| 991 | qp_lsh (&r->frac, G_GUARD);\r | |
| 992 | return;\r | |
| 993 | }\r | |
| 994 | \r | |
| 995 | void h_unpackh (int32 *hflt, UFPH *r)\r | |
| 996 | {\r | |
| 997 | r->sign = hflt[0] & FPSIGN; /* get sign */\r | |
| 998 | r->exp = H_GETEXP (hflt[0]); /* get exponent */\r | |
| 999 | if (r->exp == 0) { /* exp = 0? */\r | |
| 1000 | if (r->sign) RSVD_OPND_FAULT; /* if -, rsvd op */\r | |
| 1001 | r->frac.f0 = r->frac.f1 = 0; /* else 0 */\r | |
| 1002 | r->frac.f2 = r->frac.f3 = 0;\r | |
| 1003 | return;\r | |
| 1004 | }\r | |
| 1005 | r->frac.f3 = WORDSWAP ((hflt[0] & ~(FPSIGN | H_EXP)) | H_HB);\r | |
| 1006 | r->frac.f2 = WORDSWAP (hflt[1]);\r | |
| 1007 | r->frac.f1 = WORDSWAP (hflt[2]);\r | |
| 1008 | r->frac.f0 = WORDSWAP (hflt[3]);\r | |
| 1009 | qp_lsh (&r->frac, H_GUARD);\r | |
| 1010 | return;\r | |
| 1011 | }\r | |
| 1012 | \r | |
| 1013 | void h_normh (UFPH *r)\r | |
| 1014 | {\r | |
| 1015 | int32 i;\r | |
| 1016 | static uint32 normmask[5] = {\r | |
| 1017 | 0xc0000000, 0xf0000000, 0xff000000, 0xffff0000, 0xffffffff };\r | |
| 1018 | static int32 normtab[6] = { 1, 2, 4, 8, 16, 32};\r | |
| 1019 | \r | |
| 1020 | if ((r->frac.f0 == 0) && (r->frac.f1 == 0) &&\r | |
| 1021 | (r->frac.f2 == 0) && (r->frac.f3 == 0)) { /* if fraction = 0 */\r | |
| 1022 | r->sign = r->exp = 0; /* result is 0 */\r | |
| 1023 | return;\r | |
| 1024 | }\r | |
| 1025 | while ((r->frac.f3 & UH_NM_H) == 0) { /* normalized? */\r | |
| 1026 | for (i = 0; i < 5; i++) { /* find first 1 */\r | |
| 1027 | if (r->frac.f3 & normmask[i]) break;\r | |
| 1028 | }\r | |
| 1029 | qp_lsh (&r->frac, normtab[i]); /* shift frac */\r | |
| 1030 | r->exp = r->exp - normtab[i]; /* decr exp */\r | |
| 1031 | }\r | |
| 1032 | return;\r | |
| 1033 | }\r | |
| 1034 | \r | |
| 1035 | int32 h_rpackfd (UFPH *r, int32 *rh)\r | |
| 1036 | {\r | |
| 1037 | static UQP f_round = { 0, 0, 0, UH_FRND };\r | |
| 1038 | static UQP d_round = { 0, 0, UH_DRND, 0 };\r | |
| 1039 | \r | |
| 1040 | if (rh) *rh = 0; /* assume 0 */\r | |
| 1041 | if ((r->frac.f3 == 0) && (r->frac.f2 == 0)) return 0; /* frac = 0? done */\r | |
| 1042 | qp_add (&r->frac, rh? &d_round: &f_round);\r | |
| 1043 | if ((r->frac.f3 & UH_NM_H) == 0) { /* carry out? */\r | |
| 1044 | qp_rsh (&r->frac, 1); /* renormalize */\r | |
| 1045 | r->exp = r->exp + 1;\r | |
| 1046 | }\r | |
| 1047 | if (r->exp > (int32) FD_M_EXP) FLT_OVFL_FAULT; /* ovflo? fault */\r | |
| 1048 | if (r->exp <= 0) { /* underflow? */\r | |
| 1049 | if (PSL & PSW_FU) FLT_UNFL_FAULT; /* fault if fu */\r | |
| 1050 | return 0; /* else 0 */\r | |
| 1051 | }\r | |
| 1052 | qp_rsh (&r->frac, FD_GUARD); /* remove guard */\r | |
| 1053 | if (rh) *rh = WORDSWAP (r->frac.f2);\r | |
| 1054 | return r->sign | (r->exp << FD_V_EXP) |\r | |
| 1055 | (WORDSWAP (r->frac.f3) & ~(FD_HB | FPSIGN | FD_EXP));\r | |
| 1056 | }\r | |
| 1057 | \r | |
| 1058 | int32 h_rpackg (UFPH *r, int32 *rh)\r | |
| 1059 | {\r | |
| 1060 | static UQP g_round = { 0, 0, UH_GRND, 0 };\r | |
| 1061 | \r | |
| 1062 | *rh = 0; /* assume 0 */\r | |
| 1063 | if ((r->frac.f3 == 0) && (r->frac.f2 == 0)) return 0; /* frac = 0? done */\r | |
| 1064 | qp_add (&r->frac, &g_round); /* round */\r | |
| 1065 | if ((r->frac.f3 & UH_NM_H) == 0) { /* carry out? */\r | |
| 1066 | qp_rsh (&r->frac, 1); /* renormalize */\r | |
| 1067 | r->exp = r->exp + 1;\r | |
| 1068 | }\r | |
| 1069 | if (r->exp > (int32) G_M_EXP) FLT_OVFL_FAULT; /* ovflo? fault */\r | |
| 1070 | if (r->exp <= 0) { /* underflow? */\r | |
| 1071 | if (PSL & PSW_FU) FLT_UNFL_FAULT; /* fault if fu */\r | |
| 1072 | return 0; /* else 0 */\r | |
| 1073 | }\r | |
| 1074 | qp_rsh (&r->frac, G_GUARD); /* remove guard */\r | |
| 1075 | *rh = WORDSWAP (r->frac.f2); /* get low */\r | |
| 1076 | return r->sign | (r->exp << G_V_EXP) |\r | |
| 1077 | (WORDSWAP (r->frac.f3) & ~(G_HB | FPSIGN | G_EXP));\r | |
| 1078 | }\r | |
| 1079 | \r | |
| 1080 | int32 h_rpackh (UFPH *r, int32 *hflt)\r | |
| 1081 | {\r | |
| 1082 | static UQP h_round = { UH_HRND, 0, 0, 0 };\r | |
| 1083 | \r | |
| 1084 | hflt[0] = hflt[1] = hflt[2] = hflt[3] = 0; /* assume 0 */\r | |
| 1085 | if ((r->frac.f3 == 0) && (r->frac.f2 == 0) && /* frac = 0? done */\r | |
| 1086 | (r->frac.f1 == 0) && (r->frac.f0 == 0)) return 0;\r | |
| 1087 | if (qp_add (&r->frac, &h_round)) { /* round, carry out? */\r | |
| 1088 | qp_rsh (&r->frac, 1); /* renormalize */\r | |
| 1089 | r->exp = r->exp + 1;\r | |
| 1090 | }\r | |
| 1091 | if (r->exp > (int32) H_M_EXP) FLT_OVFL_FAULT; /* ovflo? fault */\r | |
| 1092 | if (r->exp <= 0) { /* underflow? */\r | |
| 1093 | if (PSL & PSW_FU) FLT_UNFL_FAULT; /* fault if fu */\r | |
| 1094 | return 0; /* else 0 */\r | |
| 1095 | }\r | |
| 1096 | qp_rsh (&r->frac, H_GUARD); /* remove guard */\r | |
| 1097 | hflt[0] = r->sign | (r->exp << H_V_EXP) |\r | |
| 1098 | (WORDSWAP (r->frac.f3) & ~(H_HB | FPSIGN | H_EXP));\r | |
| 1099 | hflt[1] = WORDSWAP (r->frac.f2);\r | |
| 1100 | hflt[2] = WORDSWAP (r->frac.f1);\r | |
| 1101 | hflt[3] = WORDSWAP (r->frac.f0);\r | |
| 1102 | return hflt[0];\r | |
| 1103 | }\r | |
| 1104 | \r | |
| 1105 | void h_write_b (int32 spec, int32 va, int32 val, int32 acc)\r | |
| 1106 | {\r | |
| 1107 | int32 rn;\r | |
| 1108 | \r | |
| 1109 | if (spec > (GRN | nPC)) Write (va, val, L_BYTE, WA);\r | |
| 1110 | else {\r | |
| 1111 | rn = spec & 0xF;\r | |
| 1112 | R[rn] = (R[rn] & ~BMASK) | val;\r | |
| 1113 | }\r | |
| 1114 | return;\r | |
| 1115 | }\r | |
| 1116 | \r | |
| 1117 | void h_write_w (int32 spec, int32 va, int32 val, int32 acc)\r | |
| 1118 | {\r | |
| 1119 | int32 rn;\r | |
| 1120 | \r | |
| 1121 | if (spec > (GRN | nPC)) Write (va, val, L_WORD, WA);\r | |
| 1122 | else {\r | |
| 1123 | rn = spec & 0xF;\r | |
| 1124 | R[rn] = (R[rn] & ~WMASK) | val;\r | |
| 1125 | }\r | |
| 1126 | return;\r | |
| 1127 | }\r | |
| 1128 | \r | |
| 1129 | void h_write_l (int32 spec, int32 va, int32 val, int32 acc)\r | |
| 1130 | {\r | |
| 1131 | if (spec > (GRN | nPC)) Write (va, val, L_LONG, WA);\r | |
| 1132 | else R[spec & 0xF] = val;\r | |
| 1133 | return;\r | |
| 1134 | }\r | |
| 1135 | \r | |
| 1136 | void h_write_q (int32 spec, int32 va, int32 vl, int32 vh, int32 acc)\r | |
| 1137 | {\r | |
| 1138 | int32 rn, mstat;\r | |
| 1139 | \r | |
| 1140 | if (spec > (GRN | nPC)) {\r | |
| 1141 | if ((Test (va + 7, WA, &mstat) >= 0) ||\r | |
| 1142 | (Test (va, WA, &mstat) < 0))\r | |
| 1143 | Write (va, vl, L_LONG, WA);\r | |
| 1144 | Write (va + 4, vh, L_LONG, WA);\r | |
| 1145 | }\r | |
| 1146 | else {\r | |
| 1147 | rn = spec & 0xF;\r | |
| 1148 | if (rn >= nSP) RSVD_ADDR_FAULT;\r | |
| 1149 | R[rn] = vl;\r | |
| 1150 | R[rn + 1] = vh;\r | |
| 1151 | }\r | |
| 1152 | return;\r | |
| 1153 | }\r | |
| 1154 | \r | |
| 1155 | void h_write_o (int32 spec, int32 va, int32 *val, int32 acc)\r | |
| 1156 | {\r | |
| 1157 | int32 rn, mstat;\r | |
| 1158 | \r | |
| 1159 | if (spec > (GRN | nPC)) {\r | |
| 1160 | if ((Test (va + 15, WA, &mstat) >= 0) ||\r | |
| 1161 | (Test (va, WA, &mstat) < 0))\r | |
| 1162 | Write (va, val[0], L_LONG, WA);\r | |
| 1163 | Write (va + 4, val[1], L_LONG, WA);\r | |
| 1164 | Write (va + 8, val[2], L_LONG, WA);\r | |
| 1165 | Write (va + 12, val[3], L_LONG, WA);\r | |
| 1166 | }\r | |
| 1167 | else {\r | |
| 1168 | rn = spec & 0xF;\r | |
| 1169 | if (rn >= nAP) RSVD_ADDR_FAULT;\r | |
| 1170 | R[rn] = val[0];\r | |
| 1171 | R[rn + 1] = val[1];\r | |
| 1172 | R[rn + 2] = val[2];\r | |
| 1173 | R[rn + 3] = val[3];\r | |
| 1174 | }\r | |
| 1175 | return;\r | |
| 1176 | }\r | |
| 1177 | \r | |
| 1178 | #else\r | |
| 1179 | \r | |
| 1180 | extern jmp_buf save_env;\r | |
| 1181 | \r | |
| 1182 | int32 op_octa (int32 *opnd, int32 cc, int32 opc, int32 acc, int32 spec, int32 va)\r | |
| 1183 | {\r | |
| 1184 | RSVD_INST_FAULT;\r | |
| 1185 | return cc;\r | |
| 1186 | }\r | |
| 1187 | \r | |
| 1188 | #endif\r |