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