1 /* pdp18b_fpp.c: FP15 floating point processor simulator
3 Copyright (c) 2003-2006, Robert M Supnik
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:
12 The above copyright notice and this permission notice shall be included in
13 all copies or substantial portions of the Software.
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.
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.
26 fpp PDP-15 floating point processor
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
33 The FP15 instruction format is:
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 +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
40 +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
42 Indirection is always single level.
44 The FP15 supports four data formats:
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 +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
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 +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
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 +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
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 +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
76 #include "pdp18b_defs.h"
80 #define FI_V_OP 8 /* subopcode */
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 */
90 #define FI_GETSGNOP(x) (((x) >> FI_V_SGNOP) & FI_M_SGNOP)
92 /* Exception register */
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 */
102 /* Status codes - must relate directly to JEA offsets */
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 */
110 /* Unpacked floating point fraction */
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 */
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))
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
131 int32 exp
; /* exponent */
132 int32 sign
; /* sign */
133 int32 hi
; /* hi frac, 17b */
134 int32 lo
; /* lo frac, 18b */
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 */
145 extern int32 M
[MAXMEMSIZE
];
146 extern int32 pcq
[PCQ_SIZE
];
149 extern int32 trap_pending
, usmd
;
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
);
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
);
179 /* FPP data structures
181 fpp_dev FPP device descriptor
183 fpp_reg FPP register list
184 fpp_mod FPP modifier list
187 UNIT fpp_unit
= { UDATA (NULL
, 0, 0) };
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) },
208 "FPP", &fpp_unit
, fpp_reg
, NULL
,
210 NULL
, NULL
, &fp15_reset
,
215 /* Instruction decode for FP15
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.
221 Indirect addresses are resolved during fetch, unless the NOLOAD modifier
222 is set and the instruction is not a store. */
224 t_stat
fp15 (int32 ir
)
226 int32 ar
, ma
, fop
, dat
;
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 */
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
);
241 fma
.exp
= SEXT18 (fma
.exp
); /* sext exponents */
242 fmb
.exp
= SEXT18 (fmb
.exp
);
243 switch (fop
) { /* case on subop */
245 case FOP_TST
: /* NOP */
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 */
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 */
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 */
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 */
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 */
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 */
292 case FOP_ST
: /* store */
293 fp15_asign (fir
, &fma
); /* modify A sign */
294 sta
= fp15_store (fir
, ar
, &fma
); /* store result */
297 case FOP_FLT
: /* float */
298 if (sta
= fp15_opnd (fir
, ar
, &fma
)) break; /* fetch op to FMA */
300 fp15_asign (fir
, &fma
); /* adjust A sign */
301 sta
= fp15_norm (ir
, &fma
, NULL
, 0); /* norm, no found */
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 */
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 */
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
);
322 else { /* no, load */
323 if (sta
= Read (ar
, &dat
, RD
)) break;
324 fguard
= (dat
>> JEA_V_GUARD
) & 1;
325 jea
= dat
& JEA_EAMASK
;
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 */
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 */
349 } /* end switch op */
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? */
357 /* Operand load and store */
359 t_stat
fp15_opnd (int32 ir
, int32 addr
, UFP
*fpn
)
361 int32 i
, numwd
, wd
[3];
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
;
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 */
380 fpn
->exp
= SEXT9 (wd
[0]); /* exponent */
381 fpn
->lo
= wd
[0] & UFP_FL_SMASK
; /* frac low */
385 fpn
->sign
= GET_SIGN (wd
[0]); /* int, get sign */
386 if (ir
& FI_DP
) { /* dp? */
387 fpn
->lo
= wd
[1]; /* 2 words */
391 fpn
->lo
= wd
[0]; /* 1 word */
392 fpn
->hi
= fpn
->sign
? DMASK
: 0; /* sign extended */
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
;
402 t_stat
fp15_store (int32 ir
, int32 addr
, UFP
*a
)
404 int32 i
, numwd
, wd
[3];
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 */
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 */
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 */
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 */
440 else { /* pos, store FMA */
444 numwd
= 2; /* 2 words */
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 */
453 for (i
= 0; i
< numwd
; i
++) { /* store words */
454 if (Write (addr
, wd
[i
], WR
)) return FP_MM
;
455 addr
= (addr
+ 1) & AMASK
;
460 /* Integer arithmetic routines */
462 /* Integer add - overflow only on add, if carry out of high fraction */
464 t_stat
fp15_iadd (int32 ir
, UFP
*a
, UFP
*b
, t_bool sub
)
466 fmq
.hi
= fmq
.lo
= 0; /* clear FMQ */
467 if (a
->sign
^ b
->sign
^ sub
) dp_sub (a
, b
); /* eff subtract? */
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 */
475 fp15_asign (ir
, a
); /* adjust A sign */
479 /* Integer multiply - overflow if high result (FMQ after swap) non-zero */
481 t_stat
fp15_imul (int32 ir
, UFP
*a
, UFP
*b
)
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 */
491 /* Integer divide - actually done as fraction divide
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
500 Note that dp_lsh_1 returns a 72b result; the last right shift
501 guarantees a 71b remainder. The quotient cannot exceed 71b */
503 t_stat
fp15_idiv (int32 ir
, UFP
*a
, UFP
*b
)
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 */
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 */
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 */
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 */
533 dp_lsh_1 (a
, NULL
); /* left shift divd */
535 dp_rsh_1 (a
, NULL
); /* shift back */
536 dp_swap (a
, &fmq
); /* swap a, FMQ */
537 fp15_asign (ir
, a
); /* adjust A sign */
541 /* Floating point arithmetic routines */
544 - Special add case, overflow if carry out increments exp out of range
545 - All cases, overflow/underflow detected in normalize */
547 t_stat
fp15_fadd (int32 ir
, UFP
*a
, UFP
*b
, t_bool sub
)
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 */
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 */
563 if (a
->sign
^ b
->sign
^ sub
) dp_sub (a
, b
); /* eff sub? */
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? */
574 } /* end if b != 0 */
575 fp15_asign (ir
, a
); /* adjust A sign */
576 return fp15_norm (ir
, a
, NULL
, 0); /* norm, no round */
579 /* Floating multiply - overflow/underflow detected in normalize */
581 t_stat
fp15_fmul (int32 ir
, UFP
*a
, UFP
*b
)
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 */
590 /* Floating divide - overflow/underflow detected in normalize */
592 t_stat
fp15_fdiv (int32 ir
, UFP
*a
, UFP
*b
)
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 */
609 dp_lsh_1 (a
, NULL
); /* left shift divd */
611 dp_rsh_1 (a
, NULL
); /* shift back */
612 dp_swap (a
, &fmq
); /* swap a, FMQ */
614 fp15_asign (ir
, a
); /* adjust A sign */
615 return fp15_norm (ir
, a
, &fmq
, 1); /* norm and round */
618 /* Floating to integer - overflow only if exponent out of range */
620 t_stat
fp15_fix (int32 ir
, UFP
*a
)
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 */
628 for (i
= a
->exp
; i
< 35; i
++) /* denorm frac */
630 if (fmq
.hi
& UFP_FH_NORM
) { /* last out = 1? */
631 fguard
= 1; /* set guard */
632 if (!(ir
& FI_NORND
)) dp_inc (a
); /* round */
635 fp15_asign (ir
, a
); /* adjust A sign */
639 /* Double precision routines */
641 /* Double precision add - returns 72b result (including carry) */
643 void dp_add (UFP
*a
, UFP
*b
)
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 */
650 /* Double precision increment - returns 72b result (including carry) */
654 a
->lo
= (a
->lo
+ 1) & UFP_FL_MASK
; /* inc low */
655 a
->hi
= a
->hi
+ (a
->lo
== 0); /* propagate carry */
659 /* Double precision subtract - result always fits in 71b */
661 void dp_sub (UFP
*a
, UFP
*b
)
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 */
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 */
675 /* Double precision compare - returns +1 (>), 0 (=), -1 (<) */
677 int32
dp_cmp (UFP
*a
, UFP
*b
)
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;
686 /* Double precision multiply - returns 70b result in a'fmq */
688 void dp_mul (UFP
*a
, UFP
*b
)
692 fmq
.hi
= a
->hi
; /* FMQ <- a */
694 a
->hi
= a
->lo
= 0; /* a <- 0 */
695 if ((fmq
.hi
| fmq
.lo
) == 0) return;
696 if ((b
->hi
| b
->lo
) == 0) {
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 */
707 /* Double (quad) precision left shift - returns 72b (143b) result */
709 void dp_lsh_1 (UFP
*a
, UFP
*b
)
711 int32 t
= b
? b
->hi
: 0;
713 a
->hi
= (a
->hi
<< 1) | ((a
->lo
>> 17) & 1);
714 a
->lo
= ((a
->lo
<< 1) | ((t
>> 16) & 1)) & UFP_FL_MASK
;
716 b
->hi
= ((b
->hi
<< 1) | ((b
->lo
>> 17) & 1)) & UFP_FH_MASK
;
717 b
->lo
= (b
->lo
<< 1) & UFP_FL_MASK
;
722 /* Double (quad) precision right shift - returns 71b (142b) result */
724 void dp_rsh_1 (UFP
*a
, UFP
*b
)
727 b
->lo
= (b
->lo
>> 1) | ((b
->hi
& 1) << 17);
728 b
->hi
= (b
->hi
>> 1) | ((a
->lo
& 1) << 16);
730 a
->lo
= (a
->lo
>> 1) | ((a
->hi
& 1) << 17);
735 /* Double precision denormalize and round - returns 71b result */
737 void dp_dnrm_r (int32 ir
, UFP
*a
, int32 sc
)
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 */
748 /* Double precision swap */
750 void dp_swap (UFP
*a
, UFP
*b
)
754 t
= a
->hi
; /* swap fractions */
763 /* Support routines */
765 void fp15_asign (int32 fir
, UFP
*a
)
767 int32 sgnop
= FI_GETSGNOP (fir
);
769 switch (sgnop
) { /* modify FMA sign */
780 a
->sign
= a
->sign
^ 1;
790 /* FP15 normalization and rounding
792 - Do normalization if enabled (NOR phase, part 1)
793 Normalization also does zero detect
794 - Do rounding if enabled (NOR phase, part 2) */
796 t_stat
fp15_norm (int32 ir
, UFP
*a
, UFP
*b
, t_bool rnd
)
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
;
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 */
811 else a
->sign
= a
->exp
= 0; /* true zero */
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 */
823 if (a
->exp
> (int32
) 0377777) return FP_OVF
; /* overflow? */
824 if (a
->exp
< (int32
) -0400000) return FP_UNF
; /* underflow? */
830 t_stat
fp15_exc (t_stat sta
)
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 */
846 t_stat
fp15_reset (DEVICE
*dptr
)
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;