1 /* pdp18b_fpp.c: FP15 floating point processor simulator
2
3 Copyright (c) 2003-2012, Robert M Supnik
4
5 Permission is hereby granted, free of charge, to any person obtaining a
6 copy of this software and associated documentation files (the "Software"),
7 to deal in the Software without restriction, including without limitation
8 the rights to use, copy, modify, merge, publish, distribute, sublicense,
9 and/or sell copies of the Software, and to permit persons to whom the
10 Software is furnished to do so, subject to the following conditions:
11
12 The above copyright notice and this permission notice shall be included in
13 all copies or substantial portions of the Software.
14
15 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16 IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17 FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
18 ROBERT M SUPNIK BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
19 IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
20 CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
21
22 Except as contained in this notice, the name of Robert M Supnik shall not be
23 used in advertising or otherwise to promote the sale, use or other dealings
24 in this Software without prior written authorization from Robert M Supnik.
25
26 fpp PDP-15 floating point processor
27
28 19-Mar-12 RMS Fixed declaration of pc queue (Mark Pizzolato)
29 06-Jul-06 RMS Fixed bugs in left shift, multiply
30 31-Oct-04 RMS Fixed URFST to mask low 9b of fraction
31 Fixed exception PC setting
32 10-Apr-04 RMS JEA is 15b not 18b
33
34 The FP15 instruction format is:
35
36 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
37 +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
38 | 1 1 1 0 0 1| subop | microcoded modifiers | floating point
39 +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
40 |in| address |
41 +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
42
43 Indirection is always single level.
44
45 The FP15 supports four data formats:
46
47 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
48 +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
49 | S| 2's complement integer | A: integer
50 +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
51
52 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
53 +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
54 | S| 2's complement integer (high) | A: extended integer
55 +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
56 | 2's complement integer (low) | A+1
57 +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
58
59 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
60 +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
61 | fraction (low) |SE|2's complement exponent| A: single floating
62 +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
63 |SF| fraction (high) | A+1
64 +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
65
66 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
67 +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
68 |SE| 2's complement exponent | A: double floating
69 +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
70 |SF| fraction (high) | A+1
71 +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
72 | fraction (low) | A+2
73 +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
74
75 */
76
77 #include "pdp18b_defs.h"
78
79 /* Instruction */
80
81 #define FI_V_OP 8 /* subopcode */
82 #define FI_M_OP 017
83 #define FI_GETOP(x) (((x) >> FI_V_OP) & FI_M_OP)
84 #define FI_NOLOAD 0200 /* don't load */
85 #define FI_DP 0100 /* single/double */
86 #define FI_FP 0040 /* int/flt point */
87 #define FI_NONORM 0020 /* don't normalize */
88 #define FI_NORND 0010 /* don't round */
89 #define FI_V_SGNOP 0 /* A sign change */
90 #define FI_M_SGNOP 03
91 #define FI_GETSGNOP(x) (((x) >> FI_V_SGNOP) & FI_M_SGNOP)
92
93 /* Exception register */
94
95 #define JEA_V_SIGN 17 /* A sign */
96 #define JEA_V_GUARD 16 /* guard */
97 #define JEA_EAMASK 077777 /* exc address */
98 #define JEA_OFF_OVF 0 /* ovf offset */
99 #define JEA_OFF_UNF 2 /* unf offset */
100 #define JEA_OFF_DIV 4 /* div offset */
101 #define JEA_OFF_MM 6 /* mem mgt offset */
102
103 /* Status codes - must relate directly to JEA offsets */
104
105 #define FP_OK 0 /* no error - mbz */
106 #define FP_OVF (JEA_OFF_OVF + 1) /* overflow */
107 #define FP_UNF (JEA_OFF_UNF + 1) /* underflow */
108 #define FP_DIV (JEA_OFF_DIV + 1) /* divide exception */
109 #define FP_MM (JEA_OFF_MM + 1) /* mem mgt error */
110
111 /* Unpacked floating point fraction */
112
113 #define UFP_FH_CARRY 0400000 /* carry out */
114 #define UFP_FH_NORM 0200000 /* normalized */
115 #define UFP_FH_MASK 0377777 /* hi mask */
116 #define UFP_FL_MASK 0777777 /* low mask */
117 #define UFP_FL_SMASK 0777000 /* low mask, single */
118 #define UFP_FL_SRND 0000400 /* round bit, single */
119
120 #define GET_SIGN(x) (((x) >> 17) & 1)
121 #define SEXT18(x) (((x) & SIGN)? ((x) | ~DMASK): ((x) & DMASK))
122 #define SEXT9(x) (((x) & 0400)? ((x) | ~0377): ((x) & 0377))
123
124 enum fop {
125 FOP_TST, FOP_SUB, FOP_RSUB, FOP_MUL,
126 FOP_DIV, FOP_RDIV, FOP_LD, FOP_ST,
127 FOP_FLT, FOP_FIX, FOP_LFMQ, FOP_JEA,
128 FOP_ADD, FOP_BR, FOP_DIAG, FOP_UND
129 };
130
131 typedef struct {
132 int32 exp; /* exponent */
133 int32 sign; /* sign */
134 int32 hi; /* hi frac, 17b */
135 int32 lo; /* lo frac, 18b */
136 } UFP;
137
138 static int32 fir; /* instruction */
139 static int32 jea; /* exc address */
140 static int32 fguard; /* guard bit */
141 static int32 stop_fpp = STOP_RSRV; /* stop if fp dis */
142 static UFP fma; /* FMA */
143 static UFP fmb; /* FMB */
144 static UFP fmq; /* FMQ - hi,lo only */
145
146 extern int32 M[MAXMEMSIZE];
147 #if defined (PDP15)
148 extern int32 pcq[PCQ_SIZE]; /* PC queue */
149 #else
150 extern int16 pcq[PCQ_SIZE]; /* PC queue */
151 #endif
152 extern int32 pcq_p;
153 extern int32 PC;
154 extern int32 trap_pending, usmd;
155
156 t_stat fp15_reset (DEVICE *dptr);
157 t_stat fp15_opnd (int32 ir, int32 addr, UFP *a);
158 t_stat fp15_store (int32 ir, int32 addr, UFP *a);
159 t_stat fp15_iadd (int32 ir, UFP *a, UFP *b, t_bool sub);
160 t_stat fp15_imul (int32 ir, UFP *a, UFP *b);
161 t_stat fp15_idiv (int32 ir, UFP *a, UFP *b);
162 t_stat fp15_fadd (int32 ir, UFP *a, UFP *b, t_bool sub);
163 t_stat fp15_fmul (int32 ir, UFP *a, UFP *b);
164 t_stat fp15_fdiv (int32 ir, UFP *a, UFP *b);
165 t_stat fp15_fix (int32 ir, UFP *a);
166 t_stat fp15_norm (int32 ir, UFP *a, UFP *b, t_bool rnd);
167 t_stat fp15_exc (t_stat sta);
168 void fp15_asign (int32 ir, UFP *a);
169 void dp_add (UFP *a, UFP *b);
170 void dp_sub (UFP *a, UFP *b);
171 void dp_inc (UFP *a);
172 int32 dp_cmp (UFP *a, UFP *b);
173 void dp_mul (UFP *a, UFP *b);
174 void dp_lsh_1 (UFP *a, UFP *b);
175 void dp_rsh_1 (UFP *a, UFP *b);
176 void dp_dnrm_r (int32 ir, UFP *a, int32 sc);
177 void dp_swap (UFP *a, UFP *b);
178
179 extern t_stat Read (int32 ma, int32 *dat, int32 cyc);
180 extern t_stat Write (int32 ma, int32 dat, int32 cyc);
181 extern int32 Incr_addr (int32 addr);
182 extern int32 Jms_word (int32 t);
183
184 /* FPP data structures
185
186 fpp_dev FPP device descriptor
187 fpp_unit FPP unit
188 fpp_reg FPP register list
189 fpp_mod FPP modifier list
190 */
191
192 UNIT fpp_unit = { UDATA (NULL, 0, 0) };
193
194 REG fpp_reg[] = {
195 { ORDATA (FIR, fir, 12) },
196 { ORDATA (EPA, fma.exp, 18) },
197 { FLDATA (FMAS, fma.sign, 0) },
198 { ORDATA (FMAH, fma.hi, 17) },
199 { ORDATA (FMAL, fma.lo, 18) },
200 { ORDATA (EPB, fmb.exp, 18) },
201 { FLDATA (FMBS, fmb.sign, 0) },
202 { ORDATA (FMBH, fmb.hi, 17) },
203 { ORDATA (FMBL, fmb.lo, 18) },
204 { FLDATA (FGUARD, fguard, 0) },
205 { ORDATA (FMQH, fmq.hi, 17) },
206 { ORDATA (FMQL, fmq.lo, 18) },
207 { ORDATA (JEA, jea, 15) },
208 { FLDATA (STOP_FPP, stop_fpp, 0) },
209 { NULL }
210 };
211
212 DEVICE fpp_dev = {
213 "FPP", &fpp_unit, fpp_reg, NULL,
214 1, 8, 1, 1, 8, 18,
215 NULL, NULL, &fp15_reset,
216 NULL, NULL, NULL,
217 NULL, DEV_DISABLE
218 };
219
220 /* Instruction decode for FP15
221
222 The CPU actually fetches the instruction and the word after. If the
223 instruction is 71XXXX, the CPU executes it as a NOP, and the FP15 fools
224 the CPU into thinking that the second word is also a NOP.
225
226 Indirect addresses are resolved during fetch, unless the NOLOAD modifier
227 is set and the instruction is not a store. */
228
fp15(int32 ir)229 t_stat fp15 (int32 ir)
230 {
231 int32 ar, ma, fop, dat;
232 t_stat sta = FP_OK;
233
234 if (fpp_dev.flags & DEV_DIS) /* disabled? */
235 return (stop_fpp? STOP_FPDIS: SCPE_OK);
236 fir = ir & 07777; /* save subop + mods */
237 ma = PC; /* fetch next word */
238 PC = Incr_addr (PC);
239 if (Read (ma, &ar, RD)) /* error? MM exc */
240 return fp15_exc (FP_MM);
241 fop = FI_GETOP (fir); /* get subopcode */
242 if ((ar & SIGN) && /* indirect? */
243 ((fop == FOP_ST) || !(ir & FI_NOLOAD))) { /* store or load? */
244 ma = ar & AMASK; /* fetch indirect */
245 if (Read (ma, &ar, RD))
246 return fp15_exc (FP_MM);
247 }
248 fma.exp = SEXT18 (fma.exp); /* sext exponents */
249 fmb.exp = SEXT18 (fmb.exp);
250 switch (fop) { /* case on subop */
251
252 case FOP_TST: /* NOP */
253 break;
254
255 case FOP_SUB: /* subtract */
256 if ((sta = fp15_opnd (fir, ar, &fmb))) /* fetch op to FMB */
257 break;
258 if (fir & FI_FP) /* fp? */
259 sta = fp15_fadd (fir, &fma, &fmb, 1); /* yes, fp sub */
260 else sta = fp15_iadd (fir, &fma, &fmb, 1); /* no, int sub */
261 break;
262
263 case FOP_RSUB: /* reverse sub */
264 fmb = fma; /* FMB <- FMA */
265 if ((sta = fp15_opnd (fir, ar, &fma))) /* fetch op to FMA */
266 break;
267 if (fir & FI_FP) /* fp? */
268 sta = fp15_fadd (fir, &fma, &fmb, 1); /* yes, fp sub */
269 else sta = fp15_iadd (fir, &fma, &fmb, 1); /* no, int sub */
270 break;
271
272 case FOP_MUL: /* multiply */
273 if ((sta = fp15_opnd (fir, ar, &fmb))) /* fetch op to FMB */
274 break;
275 if (fir & FI_FP) /* fp? */
276 sta = fp15_fmul (fir, &fma, &fmb); /* yes, fp mul */
277 else sta = fp15_imul (fir, &fma, &fmb); /* no, int mul */
278 break;
279
280 case FOP_DIV: /* divide */
281 if ((sta = fp15_opnd (fir, ar, &fmb))) /* fetch op to FMB */
282 break;
283 if ((sta = fp15_opnd (fir, ar, &fmb))) break; /* fetch op to FMB */
284 if (fir & FI_FP) /* fp? */
285 sta = fp15_fdiv (fir, &fma, &fmb); /* yes, fp div */
286 else sta = fp15_idiv (fir, &fma, &fmb); /* no, int div */
287 break;
288
289 case FOP_RDIV: /* reverse divide */
290 fmb = fma; /* FMB <- FMA */
291 if ((sta = fp15_opnd (fir, ar, &fma))) /* fetch op to FMA */
292 break;
293 if (fir & FI_FP) /* fp? */
294 sta = fp15_fdiv (fir, &fma, &fmb); /* yes, fp div */
295 else sta = fp15_idiv (fir, &fma, &fmb); /* no, int div */
296 break;
297
298 case FOP_LD: /* load */
299 if ((sta = fp15_opnd (fir, ar, &fma))) /* fetch op to FMA */
300 break;
301 fp15_asign (fir, &fma); /* modify A sign */
302 if (fir & FI_FP) /* fp? */
303 sta = fp15_norm (ir, &fma, NULL, 0); /* norm, no round */
304 break;
305
306 case FOP_ST: /* store */
307 fp15_asign (fir, &fma); /* modify A sign */
308 sta = fp15_store (fir, ar, &fma); /* store result */
309 break;
310
311 case FOP_FLT: /* float */
312 if ((sta = fp15_opnd (fir, ar, &fma))) /* fetch op to FMA */
313 break;
314 fma.exp = 35;
315 fp15_asign (fir, &fma); /* adjust A sign */
316 sta = fp15_norm (ir, &fma, NULL, 0); /* norm, no found */
317 break;
318
319 case FOP_FIX: /* fix */
320 if ((sta = fp15_opnd (fir, ar, &fma))) /* fetch op to FMA */
321 break;
322 sta = fp15_fix (fir, &fma); /* fix */
323 break;
324
325 case FOP_LFMQ: /* load FMQ */
326 if ((sta = fp15_opnd (fir, ar, &fma))) /* fetch op to FMA */
327 break;
328 dp_swap (&fma, &fmq); /* swap FMA, FMQ */
329 fp15_asign (fir, &fma); /* adjust A sign */
330 if (fir & FI_FP) /* fp? */
331 sta = fp15_norm (ir, &fma, &fmq, 0); /* yes, norm, no rnd */
332 break;
333
334 case FOP_JEA: /* JEA */
335 if (ir & 0200) { /* store? */
336 dat = jea | (fma.sign << JEA_V_SIGN) | (fguard << JEA_V_GUARD);
337 sta = Write (ar, dat, WR);
338 }
339 else { /* no, load */
340 if ((sta = Read (ar, &dat, RD)))
341 break;
342 fguard = (dat >> JEA_V_GUARD) & 1;
343 jea = dat & JEA_EAMASK;
344 }
345 break;
346
347 case FOP_ADD: /* add */
348 if ((sta = fp15_opnd (fir, ar, &fmb))) /* fetch op to FMB */
349 break;
350 if (fir & FI_FP) /* fp? */
351 sta = fp15_fadd (fir, &fma, &fmb, 0); /* yes, fp add */
352 else sta = fp15_iadd (fir, &fma, &fmb, 0); /* no, int add */
353 break;
354
355 case FOP_BR: /* branch */
356 if (((fir & 001) && ((fma.hi | fma.lo) == 0)) ||
357 ((fir & 002) && fma.sign) ||
358 ((fir & 004) && !fma.sign) ||
359 ((fir & 010) && ((fma.hi | fma.lo) != 0)) ||
360 ((fir & 020) && fguard)) { /* cond met? */
361 PCQ_ENTRY; /* save current PC */
362 PC = (PC & BLKMASK) | (ar & IAMASK); /* branch within 32K */
363 }
364 break;
365
366 default:
367 break;
368 } /* end switch op */
369
370 fma.exp = fma.exp & DMASK; /* mask exp to 18b */
371 fmb.exp = fmb.exp & DMASK;
372 if (sta != FP_OK) return fp15_exc (sta); /* error? */
373 return SCPE_OK;
374 }
375
376 /* Operand load and store */
377
fp15_opnd(int32 ir,int32 addr,UFP * fpn)378 t_stat fp15_opnd (int32 ir, int32 addr, UFP *fpn)
379 {
380 int32 i, numwd, wd[3];
381
382 fguard = 0; /* clear guard */
383 if (ir & FI_NOLOAD) /* no load? */
384 return FP_OK;
385 if (ir & FI_FP) /* fp? at least 2 */
386 numwd = 2;
387 else numwd = 1; /* else at least 1 */
388 if (ir & FI_DP) /* dp? 1 more */
389 numwd = numwd + 1;
390 for (i = 0; i < numwd; i++) { /* fetch words */
391 if (Read (addr, &wd[i], RD))
392 return FP_MM;
393 addr = (addr + 1) & AMASK;
394 }
395 if (ir & FI_FP) { /* fp? */
396 fpn->sign = GET_SIGN (wd[1]); /* frac sign */
397 fpn->hi = wd[1] & UFP_FH_MASK; /* frac high */
398 if (ir & FI_DP) { /* dp? */
399 fpn->exp = SEXT18 (wd[0]); /* exponent */
400 fpn->lo = wd[2]; /* frac low */
401 }
402 else { /* sp */
403 fpn->exp = SEXT9 (wd[0]); /* exponent */
404 fpn->lo = wd[0] & UFP_FL_SMASK; /* frac low */
405 }
406 }
407 else {
408 fpn->sign = GET_SIGN (wd[0]); /* int, get sign */
409 if (ir & FI_DP) { /* dp? */
410 fpn->lo = wd[1]; /* 2 words */
411 fpn->hi = wd[0];
412 }
413 else { /* single */
414 fpn->lo = wd[0]; /* 1 word */
415 fpn->hi = fpn->sign? DMASK: 0; /* sign extended */
416 }
417 if (fpn->sign) { /* negative? */
418 fpn->lo = (-fpn->lo) & UFP_FL_MASK; /* take abs val */
419 fpn->hi = (~fpn->hi + (fpn->lo == 0)) & UFP_FH_MASK;
420 }
421 }
422 return FP_OK;
423 }
424
fp15_store(int32 ir,int32 addr,UFP * a)425 t_stat fp15_store (int32 ir, int32 addr, UFP *a)
426 {
427 int32 i, numwd, wd[3];
428 t_stat sta;
429
430 fguard = 0; /* clear guard */
431 if (ir & FI_FP) { /* fp? */
432 if ((sta = fp15_norm (ir, a, NULL, 0))) /* normalize */
433 return sta;
434 if (ir & FI_DP) { /* dp? */
435 wd[0] = a->exp & DMASK; /* exponent */
436 wd[1] = (a->sign << 17) | a->hi; /* hi frac */
437 wd[2] = a->lo; /* low frac */
438 numwd = 3; /* 3 words */
439 }
440 else { /* single */
441 if (!(ir & FI_NORND) && (a->lo & UFP_FL_SRND)) { /* round? */
442 a->lo = (a->lo + UFP_FL_SRND) & UFP_FL_SMASK;
443 a->hi = (a->hi + (a->lo == 0)) & UFP_FH_MASK;
444 if ((a->hi | a->lo) == 0) { /* carry out? */
445 a->hi = UFP_FH_NORM; /* shift back */
446 a->exp = a->exp + 1;
447 }
448 }
449 if (a->exp > 0377) /* sp ovf? */
450 return FP_OVF;
451 if (a->exp < -0400) /* sp unf? */
452 return FP_UNF;
453 wd[0] = (a->exp & 0777) | (a->lo & UFP_FL_SMASK); /* low frac'exp */
454 wd[1] = (a->sign << 17) | a->hi; /* hi frac */
455 numwd = 2; /* 2 words */
456 }
457 }
458 else {
459 fmb.lo = (-a->lo) & UFP_FL_MASK; /* 2's complement */
460 fmb.hi = (~a->hi + (fmb.lo == 0)) & UFP_FH_MASK; /* to FMB */
461 if (ir & FI_DP) { /* dp? */
462 if (a->sign) { /* negative? */
463 wd[0] = fmb.hi | SIGN; /* store FMB */
464 wd[1] = fmb.lo;
465 }
466 else { /* pos, store FMA */
467 wd[0] = a->hi;
468 wd[1] = a->lo;
469 }
470 numwd = 2; /* 2 words */
471 }
472 else { /* single */
473 if (a->hi || (a->lo & SIGN)) /* check int ovf */
474 return FP_OVF;
475 if (a->sign) /* neg? store FMB */
476 wd[0] = fmb.lo;
477 else wd[0] = a->lo; /* pos, store FMA */
478 numwd = 1; /* 1 word */
479 }
480 }
481 for (i = 0; i < numwd; i++) { /* store words */
482 if (Write (addr, wd[i], WR))
483 return FP_MM;
484 addr = (addr + 1) & AMASK;
485 }
486 return FP_OK;
487 }
488
489 /* Integer arithmetic routines */
490
491 /* Integer add - overflow only on add, if carry out of high fraction */
492
fp15_iadd(int32 ir,UFP * a,UFP * b,t_bool sub)493 t_stat fp15_iadd (int32 ir, UFP *a, UFP *b, t_bool sub)
494 {
495 fmq.hi = fmq.lo = 0; /* clear FMQ */
496 if (a->sign ^ b->sign ^ sub) /* eff subtract? */
497 dp_sub (a, b);
498 else {
499 dp_add (a, b); /* no, add */
500 if (a->hi & UFP_FH_CARRY) { /* carry out? */
501 a->hi = a->hi & UFP_FH_MASK; /* mask to 35b */
502 return FP_OVF; /* overflow */
503 }
504 }
505 fp15_asign (ir, a); /* adjust A sign */
506 return FP_OK;
507 }
508
509 /* Integer multiply - overflow if high result (FMQ after swap) non-zero */
510
fp15_imul(int32 ir,UFP * a,UFP * b)511 t_stat fp15_imul (int32 ir, UFP *a, UFP *b)
512 {
513 a->sign = a->sign ^ b->sign; /* sign of result */
514 dp_mul (a, b); /* a'FMQ <- a * b */
515 dp_swap (a, &fmq); /* swap a, FMQ */
516 if (fmq.hi | fmq.lo) /* FMQ != 0? ovf */
517 return FP_OVF;
518 fp15_asign (ir, a); /* adjust A sign */
519 return FP_OK;
520 }
521
522 /* Integer divide - actually done as fraction divide
523
524 - If divisor zero, error
525 - If dividend zero, done
526 - Normalize dividend and divisor together
527 - If divisor normalized but dividend not, result is zero
528 - If divisor not normalized, normalize and count shifts
529 - Do fraction divide for number of shifts, +1, steps
530
531 Note that dp_lsh_1 returns a 72b result; the last right shift
532 guarantees a 71b remainder. The quotient cannot exceed 71b */
533
fp15_idiv(int32 ir,UFP * a,UFP * b)534 t_stat fp15_idiv (int32 ir, UFP *a, UFP *b)
535 {
536 int32 i, sc;
537
538 a->sign = a->sign ^ b->sign; /* sign of result */
539 fmq.hi = fmq.lo = 0; /* clear quotient */
540 a->exp = 0; /* clear a exp */
541 if ((b->hi | b->lo) == 0) /* div by 0? */
542 return FP_DIV;
543 if ((a->hi | a->lo) == 0) /* div into 0? */
544 return FP_OK;
545 while (((a->hi & UFP_FH_NORM) == 0) && /* normalize divd */
546 ((b->hi & UFP_FH_NORM) == 0)) { /* and divr */
547 dp_lsh_1 (a, NULL); /* lsh divd, divr */
548 dp_lsh_1 (b, NULL); /* can't carry out */
549 }
550 if (!(a->hi & UFP_FH_NORM) && (b->hi & UFP_FH_NORM)) { /* divr norm, divd not? */
551 dp_swap (a, &fmq); /* quo = 0 (fmq), rem = a */
552 return FP_OK;
553 }
554 while ((b->hi & UFP_FH_NORM) == 0) { /* normalize divr */
555 dp_lsh_1 (b, NULL); /* can't carry out */
556 a->exp = a->exp + 1; /* count steps */
557 }
558 sc = a->exp;
559 for (i = 0; i <= sc; i++) { /* n+1 steps */
560 dp_lsh_1 (&fmq, NULL); /* left shift quo */
561 if (dp_cmp (a, b) >= 0) { /* sub work? */
562 dp_sub (a, b); /* a -= b */
563 if (i == 0) /* first step? */
564 a->exp = a->exp + 1;
565 fmq.lo = fmq.lo | 1; /* set quo bit */
566 }
567 dp_lsh_1 (a, NULL); /* left shift divd */
568 }
569 dp_rsh_1 (a, NULL); /* shift back */
570 dp_swap (a, &fmq); /* swap a, FMQ */
571 fp15_asign (ir, a); /* adjust A sign */
572 return FP_OK;
573 }
574
575 /* Floating point arithmetic routines */
576
577 /* Floating add
578 - Special add case, overflow if carry out increments exp out of range
579 - All cases, overflow/underflow detected in normalize */
580
fp15_fadd(int32 ir,UFP * a,UFP * b,t_bool sub)581 t_stat fp15_fadd (int32 ir, UFP *a, UFP *b, t_bool sub)
582 {
583 int32 ediff;
584
585 fmq.hi = fmq.lo = 0; /* clear FMQ */
586 ediff = a->exp - b->exp; /* exp diff */
587 if (((a->hi | a->lo) == 0) || (ediff < -35)) { /* a = 0 or "small"? */
588 *a = *b; /* rslt is b */
589 a->sign = a->sign ^ sub; /* or -b if sub */
590 }
591 else if (((b->hi | b->lo) != 0) && (ediff <= 35)) { /* b!=0 && ~"small"? */
592 if (ediff > 0) /* |a| > |b|? dnorm b */
593 dp_dnrm_r (ir, b, ediff);
594 else if (ediff < 0) { /* |a| < |b|? */
595 a->exp = b->exp; /* b exp is rslt */
596 dp_dnrm_r (ir, a, -ediff); /* denorm A */
597 }
598 if (a->sign ^ b->sign ^ sub) /* eff sub? */
599 dp_sub (a, b);
600 else { /* eff add */
601 dp_add (a, b); /* add */
602 if (a->hi & UFP_FH_CARRY) { /* carry out? */
603 fguard = a->lo & 1; /* set guard */
604 dp_rsh_1 (a, NULL); /* right shift */
605 a->exp = a->exp + 1; /* incr exponent */
606 if (!(ir & FI_NORND) && fguard) /* rounding? */
607 dp_inc (a);
608 }
609 }
610 } /* end if b != 0 */
611 fp15_asign (ir, a); /* adjust A sign */
612 return fp15_norm (ir, a, NULL, 0); /* norm, no round */
613 }
614
615 /* Floating multiply - overflow/underflow detected in normalize */
616
fp15_fmul(int32 ir,UFP * a,UFP * b)617 t_stat fp15_fmul (int32 ir, UFP *a, UFP *b)
618 {
619 a->sign = a->sign ^ b->sign; /* sign of result */
620 a->exp = a->exp + b->exp; /* exp of result */
621 dp_mul (a, b); /* mul fractions */
622 fp15_asign (ir, a); /* adjust A sign */
623 return fp15_norm (ir, a, &fmq, 1); /* norm and round */
624 }
625
626 /* Floating divide - overflow/underflow detected in normalize */
627
fp15_fdiv(int32 ir,UFP * a,UFP * b)628 t_stat fp15_fdiv (int32 ir, UFP *a, UFP *b)
629 {
630 int32 i;
631
632 a->sign = a->sign ^ b->sign; /* sign of result */
633 a->exp = a->exp - b->exp; /* exp of result */
634 fmq.hi = fmq.lo = 0; /* clear quotient */
635 if (!(b->hi & UFP_FH_NORM)) /* divr not norm? */
636 return FP_DIV;
637 if (a->hi | a->lo) { /* divd non-zero? */
638 fp15_norm (0, a, NULL, 0); /* normalize divd */
639 for (i = 0; (fmq.hi & UFP_FH_NORM) == 0; i++) { /* until quo */
640 dp_lsh_1 (&fmq, NULL); /* left shift quo */
641 if (dp_cmp (a, b) >= 0) { /* sub work? */
642 dp_sub (a, b); /* a = a - b */
643 if (i == 0)
644 a->exp = a->exp + 1;
645 fmq.lo = fmq.lo | 1; /* set quo bit */
646 }
647 dp_lsh_1 (a, NULL); /* left shift divd */
648 }
649 dp_rsh_1 (a, NULL); /* shift back */
650 dp_swap (a, &fmq); /* swap a, FMQ */
651 }
652 fp15_asign (ir, a); /* adjust A sign */
653 return fp15_norm (ir, a, &fmq, 1); /* norm and round */
654 }
655
656 /* Floating to integer - overflow only if exponent out of range */
657
fp15_fix(int32 ir,UFP * a)658 t_stat fp15_fix (int32 ir, UFP *a)
659 {
660 int32 i;
661
662 fmq.hi = fmq.lo = 0; /* clear FMQ */
663 if (a->exp > 35) /* exp > 35? ovf */
664 return FP_OVF;
665 if (a->exp < 0) /* exp <0 ? rslt 0 */
666 a->hi = a->lo = 0;
667 else {
668 for (i = a->exp; i < 35; i++) /* denorm frac */
669 dp_rsh_1 (a, &fmq);
670 if (fmq.hi & UFP_FH_NORM) { /* last out = 1? */
671 fguard = 1; /* set guard */
672 if (!(ir & FI_NORND)) /* round */
673 dp_inc (a);
674 }
675 }
676 fp15_asign (ir, a); /* adjust A sign */
677 return FP_OK;
678 }
679
680 /* Double precision routines */
681
682 /* Double precision add - returns 72b result (including carry) */
683
dp_add(UFP * a,UFP * b)684 void dp_add (UFP *a, UFP *b)
685 {
686 a->lo = (a->lo + b->lo) & UFP_FL_MASK; /* add low */
687 a->hi = a->hi + b->hi + (a->lo < b->lo); /* add hi + carry */
688 return;
689 }
690
691 /* Double precision increment - returns 72b result (including carry) */
692
dp_inc(UFP * a)693 void dp_inc (UFP *a)
694 {
695 a->lo = (a->lo + 1) & UFP_FL_MASK; /* inc low */
696 a->hi = a->hi + (a->lo == 0); /* propagate carry */
697 return;
698 }
699
700 /* Double precision subtract - result always fits in 71b */
701
dp_sub(UFP * a,UFP * b)702 void dp_sub (UFP *a, UFP *b)
703 {
704 if (dp_cmp (a,b) >= 0) { /* |a| >= |b|? */
705 a->hi = (a->hi - b->hi - (a->lo < b->lo)) & UFP_FH_MASK;
706 a->lo = (a->lo - b->lo) & UFP_FL_MASK; /* a - b */
707 }
708 else {
709 a->hi = (b->hi - a->hi - (b->lo < a->lo)) & UFP_FH_MASK;
710 a->lo = (b->lo - a->lo) & UFP_FL_MASK; /* b - a */
711 a->sign = a->sign ^ 1; /* change a sign */
712 }
713 return;
714 }
715
716 /* Double precision compare - returns +1 (>), 0 (=), -1 (<) */
717
dp_cmp(UFP * a,UFP * b)718 int32 dp_cmp (UFP *a, UFP *b)
719 {
720 if (a->hi < b->hi)
721 return -1;
722 if (a->hi > b->hi)
723 return +1;
724 if (a->lo < b->lo)
725 return -1;
726 if (a->lo > b->lo)
727 return +1;
728 return 0;
729 }
730
731 /* Double precision multiply - returns 70b result in a'fmq */
732
dp_mul(UFP * a,UFP * b)733 void dp_mul (UFP *a, UFP *b)
734 {
735 int32 i;
736
737 fmq.hi = a->hi; /* FMQ <- a */
738 fmq.lo = a->lo;
739 a->hi = a->lo = 0; /* a <- 0 */
740 if ((fmq.hi | fmq.lo) == 0)
741 return;
742 if ((b->hi | b->lo) == 0) {
743 fmq.hi = fmq.lo = 0;
744 return;
745 }
746 for (i = 0; i < 35; i++) { /* 35 iterations */
747 if (fmq.lo & 1) /* FMQ<35>? a += b */
748 dp_add (a, b);
749 dp_rsh_1 (a, &fmq); /* rsh a'FMQ */
750 }
751 return;
752 }
753
754 /* Double (quad) precision left shift - returns 72b (143b) result */
755
dp_lsh_1(UFP * a,UFP * b)756 void dp_lsh_1 (UFP *a, UFP *b)
757 {
758 int32 t = b? b->hi: 0;
759
760 a->hi = (a->hi << 1) | ((a->lo >> 17) & 1);
761 a->lo = ((a->lo << 1) | ((t >> 16) & 1)) & UFP_FL_MASK;
762 if (b) {
763 b->hi = ((b->hi << 1) | ((b->lo >> 17) & 1)) & UFP_FH_MASK;
764 b->lo = (b->lo << 1) & UFP_FL_MASK;
765 }
766 return;
767 }
768
769 /* Double (quad) precision right shift - returns 71b (142b) result */
770
dp_rsh_1(UFP * a,UFP * b)771 void dp_rsh_1 (UFP *a, UFP *b)
772 {
773 if (b) {
774 b->lo = (b->lo >> 1) | ((b->hi & 1) << 17);
775 b->hi = (b->hi >> 1) | ((a->lo & 1) << 16);
776 }
777 a->lo = (a->lo >> 1) | ((a->hi & 1) << 17);
778 a->hi = a->hi >> 1;
779 return;
780 }
781
782 /* Double precision denormalize and round - returns 71b result */
783
dp_dnrm_r(int32 ir,UFP * a,int32 sc)784 void dp_dnrm_r (int32 ir, UFP *a, int32 sc)
785 {
786 int32 i;
787
788 if (sc <= 0) /* legit? */
789 return;
790 for (i = 0; i < sc; i++) /* dnorm to fmq */
791 dp_rsh_1 (a, &fmq);
792 if (!(ir & FI_NORND) && (fmq.hi & UFP_FH_NORM)) /* round & fmq<1>? */
793 dp_inc (a); /* incr a */
794 return;
795 }
796
797 /* Double precision swap */
798
dp_swap(UFP * a,UFP * b)799 void dp_swap (UFP *a, UFP *b)
800 {
801 int32 t;
802
803 t = a->hi; /* swap fractions */
804 a->hi = b->hi;
805 b->hi = t;
806 t = a->lo;
807 a->lo = b->lo;
808 b->lo = t;
809 return;
810 }
811
812 /* Support routines */
813
fp15_asign(int32 fir,UFP * a)814 void fp15_asign (int32 fir, UFP *a)
815 {
816 int32 sgnop = FI_GETSGNOP (fir);
817
818 switch (sgnop) { /* modify FMA sign */
819
820 case 1:
821 a->sign = 0;
822 break;
823
824 case 2:
825 a->sign = 1;
826 break;
827
828 case 3:
829 a->sign = a->sign ^ 1;
830 break;
831
832 default:
833 break;
834 }
835
836 return;
837 }
838
839 /* FP15 normalization and rounding
840
841 - Do normalization if enabled (NOR phase, part 1)
842 Normalization also does zero detect
843 - Do rounding if enabled (NOR phase, part 2) */
844
fp15_norm(int32 ir,UFP * a,UFP * b,t_bool rnd)845 t_stat fp15_norm (int32 ir, UFP *a, UFP *b, t_bool rnd)
846 {
847 a->hi = a->hi & UFP_FH_MASK; /* mask a */
848 a->lo = a->lo & UFP_FL_MASK;
849 if (b) { /* if b, mask */
850 b->hi = b->hi & UFP_FH_MASK;
851 b->lo = b->lo & UFP_FL_MASK;
852 }
853 if (!(ir & FI_NONORM)) { /* norm enabled? */
854 if ((a->hi | a->lo) || (b && (b->hi | b->lo))) { /* frac != 0? */
855 while ((a->hi & UFP_FH_NORM) == 0) { /* until norm */
856 dp_lsh_1 (a, b); /* lsh a'b, no cry */
857 a->exp = a->exp - 1; /* decr exp */
858 }
859 }
860 else a->sign = a->exp = 0; /* true zero */
861 }
862 if (rnd && b && (b->hi & UFP_FH_NORM)) { /* rounding? */
863 fguard = 1; /* set guard */
864 if (!(ir & FI_NORND)) { /* round enabled? */
865 dp_inc (a); /* add 1 */
866 if (a->hi & UFP_FH_CARRY) { /* carry out? */
867 a->hi = UFP_FH_NORM; /* set hi bit */
868 a->exp = a->exp + 1; /* incr exp */
869 }
870 }
871 }
872 if (a->exp > (int32) 0377777) /* overflow? */
873 return FP_OVF;
874 if (a->exp < (int32) -0400000) /* underflow? */
875 return FP_UNF;
876 return FP_OK;
877 }
878
879 /* Exception */
880
fp15_exc(t_stat sta)881 t_stat fp15_exc (t_stat sta)
882 {
883 int32 ma, mb;
884
885 if (sta == FP_MM) /* if mm, kill trap */
886 trap_pending = 0;
887 ma = (jea & JEA_EAMASK) + sta - 1; /* JEA address */
888 PCQ_ENTRY; /* record branch */
889 PC = Incr_addr (PC); /* PC+1 for "JMS" */
890 mb = Jms_word (usmd); /* form JMS word */
891 if (Write (ma, mb, WR)) /* store */
892 return SCPE_OK;
893 PC = (ma + 1) & IAMASK; /* new PC */
894 return SCPE_OK;
895 }
896
897 /* Reset routine */
898
fp15_reset(DEVICE * dptr)899 t_stat fp15_reset (DEVICE *dptr)
900 {
901 jea = 0;
902 fir = 0;
903 fguard = 0;
904 fma.exp = fma.hi = fma.lo = fma.sign = 0;
905 fmb.exp = fmb.hi = fmb.lo = fmb.sign = 0;
906 fmq.exp = fmq.hi = fmq.lo = fmq.sign = 0;
907 return SCPE_OK;
908 }
909