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