1 " code definition segment for Fortran complex 2 " 3 " Modified: 8 August 1978 by Richard A. Barnes to fix 1731 4 " 5 " we assume that the only type of complex data is cfl1 and that at least 6 " one operand has this type 7 " 8 name complex_stuff 9 segdef complex_stuff 10 segdef complex_compare 11 " 12 equ arg1,1*4096 13 equ arg2,2*4096 14 equ arg3,3*4096 15 " 16 bool fx1_to_fl2_,465 17 bool op_vec,551 from assembly of pl2_operators 18 " 19 bool aq,600000 20 " 21 complex_stuff: 22 erase aq 23 switch 17,op 24 jump plus 25 jump minus 26 jump times 27 jump divide 28 jump negate 29 plus: 30 switch 0,code 31 jump plus_HH 32 jump plus_HE 33 flipto plus_HE actually plus_EH 34 plus_EE: 35 plus_EE_cfl1: 36 switch 3,type2 37 jump plus_EE_cfl1_fl1_cfl1 38 jump plus_EE_cfl1_fl2_cfl1 39 jump 0 40 jump 0 41 plus_EE_cfl1_cfl1: 42 switch 3,type3 43 flipto plus_EE_cfl1_fl1_cfl1 44 flipto plus_EE_cfl1_fl2_cfl1 45 jump 0 46 jump 0 47 plus_EE_cfl1_cfl1_cfl1: 48 bump arg2 49 bump arg3 50 fld arg2 51 fad arg3 52 fst arg1 53 fld arg2+1 54 fad arg3+1 55 fst arg1+1 56 drop arg2 57 drop arg3 58 ** 59 plus_EE_cfl1_fl1_cfl1: 60 plus_EE_cfl1_fl2_cfl1: 61 load arg2 62 l1: bump arg3 63 erase aq 64 fad arg3 65 fst arg1 66 fld arg3+1 67 fst arg1+1 68 drop arg3 69 ** 70 plus_HE: 71 plus_HE_cfl1: 72 switch 3,type2 73 jump plus_HE_cfl1_fl1_cfl1 74 jump plus_HE_cfl1_fl2_cfl1 75 jump 0 76 jump 0 77 plus_HE_cfl1_cfl1: 78 switch 3,type3 79 jump plus_HE_cfl1_cfl1_fl1 80 jump plus_HE_cfl1_cfl1_fl2 81 jump 0 82 jump 0 83 plus_HE_cfl1_cfl1_cfl1: 84 cplalt arg2 85 jump plus_EE_cfl1_cfl1_cfl1 86 plus_HE_cfl1_fl1_cfl1: 87 plus_HE_cfl1_fl2_cfl1: 88 compile arg2 89 jump l1 90 plus_HE_cfl1_cfl1_fl1: 91 plus_HE_cfl1_cfl1_fl2: 92 cplalt arg2 93 bump arg2 94 fld arg2 95 fad arg3 96 jump l5 97 plus_HH: 98 plus_HH_cfl1: 99 switch 3,type2 100 jump plus_HH_cfl1_fl1_cfl1 101 jump plus_HH_cfl1_fl2_cfl1 102 jump 0 103 jump 0 104 plus_HH_cfl1_cfl1: 105 switch 3,type3 106 flipto plus_HH_cfl1_fl1_cfl1 107 flipto plus_HH_cfl1_fl2_cfl1 108 jump 0 109 jump 0 110 plus_HH_cfl1_cfl1_cfl1: 111 cplsave arg3 112 jump plus_HE_cfl1_cfl1_cfl1 113 plus_HH_cfl1_fl1_cfl1: 114 plus_HH_cfl1_fl2_cfl1: 115 cplalt arg3 116 compile arg2 117 jump l1 118 " 119 minus: 120 switch 0,code 121 jump minus_HH 122 jump minus_HE 123 jump minus_EH 124 minus_EE: 125 minus_EE_cfl1: 126 switch 3,type2 127 jump minus_EE_cfl1_fl1_cfl1 128 jump minus_EE_cfl1_fl2_cfl1 129 jump 0 130 jump 0 131 minus_EE_cfl1_cfl1: 132 switch 3,type3 133 jump minus_EE_cfl1_cfl1_fl1 134 jump minus_EE_cfl1_cfl1_fl2 135 jump 0 136 jump 0 137 minus_EE_cfl1_cfl1_cfl1: 138 bump arg2 139 bump arg3 140 fld arg2 141 fsb arg3 142 fst arg1 143 fld arg2+1 144 l3: fsb arg3+1 145 fst arg1+1 146 drop arg2 147 drop arg3 148 ** 149 minus_EE_cfl1_fl1_cfl1: 150 minus_EE_cfl1_fl2_cfl1: 151 minus_HE_cfl1_fl1_cfl1: 152 minus_HE_cfl1_fl2_cfl1: 153 bump arg2 154 bump arg3 155 fetch arg2 156 erase aq 157 fsb arg3 158 fst arg1 159 fld =0.0,du 160 jump l3 161 minus_EE_cfl1_cfl1_fl1: 162 minus_EE_cfl1_cfl1_fl2: 163 bump arg2 164 fld arg2 165 fsb arg3 166 l5: fst arg1 167 fld arg2+1 168 fst arg1+1 169 drop arg2 170 ** 171 minus_EH: 172 minus_EH_cfl1: 173 switch 3,type2 174 jump minus_EH_cfl1_fl1_cfl1 175 jump minus_EH_cfl1_fl2_cfl1 176 jump 0 177 jump 0 178 minus_EH_cfl1_cfl1: 179 switch 3,type3 180 jump minus_EH_cfl1_cfl1_fl1 181 jump minus_EH_cfl1_cfl1_fl2 182 jump 0 183 jump 0 184 minus_EH_cfl1_cfl1_cfl1: 185 cplalt arg3 186 jump minus_EE_cfl1_cfl1_cfl1 187 minus_EH_cfl1_fl1_cfl1: 188 minus_EH_cfl1_fl2_cfl1: 189 cplalt arg3 190 jump minus_EE_cfl1_fl1_cfl1 191 minus_EH_cfl1_cfl1_fl1: 192 minus_EH_cfl1_cfl1_fl2: 193 bump arg2 194 compile arg3 195 erase aq 196 fneg 0 197 fad arg2 198 jump l5 199 minus_HE: 200 minus_HE_cfl1: 201 switch 3,type2 202 jump minus_HE_cfl1_fl1_cfl1 203 jump minus_HE_cfl1_fl2_cfl1 204 jump 0 205 jump 0 206 minus_HE_cfl1_cfl1: 207 switch 3,type3 208 jump minus_HE_cfl1_cfl1_fl1 209 jump minus_HE_cfl1_cfl1_fl2 210 jump 0 211 jump 0 212 minus_HE_cfl1_cfl1_cfl1: 213 cplalt arg2 214 jump minus_EE_cfl1_cfl1_cfl1 215 minus_HE_cfl1_cfl1_fl1: 216 minus_HE_cfl1_cfl1_fl2: 217 cplalt arg2 218 jump minus_EE_cfl1_cfl1_fl1 219 minus_HH: 220 cplsave arg3 221 jump minus_HE 222 times: 223 switch 0,code 224 jump times_HH 225 jump times_HE 226 flipto times_HE actual times_EH 227 times_EE: 228 times_EE_cfl1: 229 switch 3,type2 230 jump times_EE_cfl1_fl1_cfl1 231 jump times_EE_cfl1_fl2_cfl1 232 jump 0 233 jump 0 234 times_EE_cfl1_cfl1: 235 switch 3,type3 236 flipto times_EE_cfl1_fl1_cfl1 237 flipto times_EE_cfl1_fl2_cfl1 238 jump 0 239 jump 0 240 times_EE_cfl1_cfl1_cfl1: 241 bump arg2 242 bump arg3 243 ldaq arg2 244 l9: eppbp arg3 245 tsx0 ap|op_vec+146 246 drop arg2 247 drop arg3 248 ** 249 times_EE_cfl1_fl1_cfl1: 250 times_EE_cfl1_fl2_cfl1: 251 bump arg2 252 bump arg3 253 load arg2 254 l6: fmp arg3 255 fst arg1 256 erase aq 257 load arg2 258 fmp arg3+1 259 fst arg1+1 260 drop arg3 261 erase aq 262 ** 263 times_HE: 264 times_HE_cfl1: 265 switch 3,type2 266 jump times_HE_cfl1_fl1_cfl1 267 jump times_HE_cfl1_fl2_cfl1 268 jump 0 269 jump 0 270 times_HE_cfl1_cfl1: 271 switch 3,type3 272 jump times_HE_cfl1_cfl1_fl1 273 jump times_HE_cfl1_cfl1_fl2 274 jump 0 275 jump 0 276 times_HE_cfl1_cfl1_cfl1: 277 bump arg3 278 cplalt arg2 279 bump arg2 280 if c2 281 eppbp arg3 282 tsx0 ap|op_vec+145 283 drop arg2 284 drop arg3 285 ** 286 ldaq arg2 287 jump l9 288 times_HE_cfl1_fl1_cfl1: 289 times_HE_cfl1_fl2_cfl1: 290 bump arg3 291 cplsave arg2 292 jump l6 293 times_HE_cfl1_cfl1_fl1: 294 times_HE_cfl1_cfl1_fl2: 295 cplalt arg2 296 flipto times_EE_cfl1_fl1_cfl1 297 times_HH: 298 times_HH_cfl1: 299 switch 3,type2 300 jump times_HH_cfl1_fl1_cfl1 301 jump times_HH_cfl1_fl2_cfl1 302 jump 0 303 jump 0 304 times_HH_cfl1_cfl1: 305 switch 3,type3 306 flipto times_HH_cfl1_fl1_cfl1 307 flipto times_HH_cfl1_fl2_cfl1 308 jump 0 309 jump 0 310 times_HH_cfl1_cfl1_cfl1: 311 cplsave arg3 312 jump times_HE_cfl1_cfl1_cfl1 313 times_HH_cfl1_fl1_cfl1: 314 times_HH_cfl1_fl2_cfl1: 315 cplalt arg3 316 bump arg3 317 cplsave arg2 318 jump l6 319 divide: 320 switch 0,code 321 jump divide_HH 322 jump divide_HE 323 jump divide_EH 324 divide_EE: 325 divide_EE_cfl1: 326 switch 3,type2 327 jump divide_EE_cfl1_fl1_cfl1 328 jump divide_EE_cfl1_fl2_cfl1 329 jump 0 330 jump 0 331 divide_EE_cfl1_cfl1: 332 switch 3,type3 333 jump divide_EE_cfl1_cfl1_fl1 334 jump divide_EE_cfl1_cfl1_fl2 335 jump 0 336 jump 0 337 divide_EE_cfl1_cfl1_cfl1: 338 bump arg2 339 bump arg3 340 ldaq arg2 341 l7: eppbp arg3 342 tsx0 ap|op_vec+148 343 drop arg2 344 drop arg3 345 ** 346 divide_EE_cfl1_fl1_cfl1: 347 divide_EE_cfl1_fl2_cfl1: 348 bump arg2 349 bump arg3 350 lda arg2 351 ldq =0.0,du 352 jump l7 353 divide_EE_cfl1_cfl1_fl1: 354 divide_EE_cfl1_cfl1_fl2: 355 bump arg2 356 bump arg3 357 load arg3 358 fdi arg2 359 fst arg1 360 erase aq 361 load arg3 362 fdi arg2+1 363 fst arg1+1 364 drop arg2 365 ** 366 divide_EH: 367 cplsave arg3 368 jump divide_EE 369 divide_HE: 370 divide_HE_cfl1: 371 switch 3,type2 372 jump divide_HE_cfl1_fl1_cfl1 373 jump divide_HE_cfl1_fl2_cfl1 374 jump 0 375 jump 0 376 divide_HE_cfl1_cfl1: 377 switch 3,type3 378 jump divide_HE_cfl1_cfl1_fl1 379 jump divide_HE_cfl1_cfl1_fl2 380 jump 0 381 jump 0 382 divide_HE_cfl1_cfl1_cfl1: 383 bump arg3 384 cplalt arg2 385 bump arg2 386 if c2 387 eppbp arg3 388 tsx0 ap|op_vec+147 389 drop arg2 390 drop arg3 391 ** 392 ldaq arg2 393 jump l7 394 divide_HE_cfl1_fl1_cfl1: 395 divide_HE_cfl1_fl2_cfl1: 396 cplsave arg2 397 jump divide_EE_cfl1_fl1_cfl1 398 divide_HE_cfl1_cfl1_fl1: 399 divide_HE_cfl1_cfl1_fl2: 400 cplalt arg2 401 jump divide_EE_cfl1_cfl1_fl1 402 divide_HH: 403 cplsave arg3 404 jump divide_HE 405 negate: 406 ifnot atm2 407 cplalt arg2 408 * 409 bump arg2 410 fld arg2 411 fneg 0 412 fst arg1 413 fld arg2+1 414 fneg 0 415 fst arg1+1 416 drop arg2 417 ** 418 " 419 " table defining complex comparison for Fortran 420 " 421 complex_compare: 422 switch 0,code 423 jump HH 424 jump HE 425 flipto HE really EH 426 EE: 427 if q3 428 cmpaq arg2 429 ** 430 c1: load arg2 431 cmpaq arg3 432 ** 433 HH: 434 cplsave arg3 435 HE: 436 cplalt arg2 437 jump c1 438 end