projects / simh.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
First Commit of my working state
[simh.git] / PDP18B / pdp18b_fpp.c
CommitLineData
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
123enum 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
130typedef 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
137static int32 fir; /* instruction */\r
138static int32 jea; /* exc address */\r
139static int32 fguard; /* guard bit */\r
140static int32 stop_fpp = STOP_RSRV; /* stop if fp dis */\r
141static UFP fma; /* FMA */\r
142static UFP fmb; /* FMB */\r
143static UFP fmq; /* FMQ - hi,lo only */\r
144\r
145extern int32 M[MAXMEMSIZE];\r
146extern int32 pcq[PCQ_SIZE];\r
147extern int32 pcq_p;\r
148extern int32 PC;\r
149extern int32 trap_pending, usmd;\r
150\r
151t_stat fp15_reset (DEVICE *dptr);\r
152t_stat fp15_opnd (int32 ir, int32 addr, UFP *a);\r
153t_stat fp15_store (int32 ir, int32 addr, UFP *a);\r
154t_stat fp15_iadd (int32 ir, UFP *a, UFP *b, t_bool sub);\r
155t_stat fp15_imul (int32 ir, UFP *a, UFP *b);\r
156t_stat fp15_idiv (int32 ir, UFP *a, UFP *b);\r
157t_stat fp15_fadd (int32 ir, UFP *a, UFP *b, t_bool sub);\r
158t_stat fp15_fmul (int32 ir, UFP *a, UFP *b);\r
159t_stat fp15_fdiv (int32 ir, UFP *a, UFP *b);\r
160t_stat fp15_fix (int32 ir, UFP *a);\r
161t_stat fp15_norm (int32 ir, UFP *a, UFP *b, t_bool rnd);\r
162t_stat fp15_exc (int32 sta);\r
163void fp15_asign (int32 ir, UFP *a);\r
164void dp_add (UFP *a, UFP *b);\r
165void dp_sub (UFP *a, UFP *b);\r
166void dp_inc (UFP *a);\r
167int32 dp_cmp (UFP *a, UFP *b);\r
168void dp_mul (UFP *a, UFP *b);\r
169void dp_lsh_1 (UFP *a, UFP *b);\r
170void dp_rsh_1 (UFP *a, UFP *b);\r
171void dp_dnrm_r (int32 ir, UFP *a, int32 sc);\r
172void dp_swap (UFP *a, UFP *b);\r
173\r
174extern t_stat Read (int32 ma, int32 *dat, int32 cyc);\r
175extern t_stat Write (int32 ma, int32 dat, int32 cyc);\r
176extern int32 Incr_addr (int32 addr);\r
177extern 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
187UNIT fpp_unit = { UDATA (NULL, 0, 0) };\r
188\r
189REG 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
207DEVICE 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
224t_stat fp15 (int32 ir)\r
225{\r
226int32 ar, ma, fop, dat;\r
227t_stat sta = FP_OK;\r
228\r
229if (fpp_dev.flags & DEV_DIS) /* disabled? */\r
230 return (stop_fpp? STOP_FPDIS: SCPE_OK);\r
231fir = ir & 07777; /* save subop + mods */\r
232ma = PC; /* fetch next word */\r
233PC = Incr_addr (PC);\r
234if (Read (ma, &ar, RD)) return fp15_exc (FP_MM); /* error? MM exc */\r
235fop = FI_GETOP (fir); /* get subopcode */\r
236if ((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
241fma.exp = SEXT18 (fma.exp); /* sext exponents */\r
242fmb.exp = SEXT18 (fmb.exp);\r
243switch (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
351fma.exp = fma.exp & DMASK; /* mask exp to 18b */\r
352fmb.exp = fmb.exp & DMASK;\r
353if (sta != FP_OK) return fp15_exc (sta); /* error? */\r
354return SCPE_OK;\r
355}\r
356\r
357/* Operand load and store */\r
358\r
359t_stat fp15_opnd (int32 ir, int32 addr, UFP *fpn)\r
360{\r
361int32 i, numwd, wd[3];\r
362\r
363fguard = 0; /* clear guard */\r
364if (ir & FI_NOLOAD) return FP_OK; /* no load? */\r
365if (ir & FI_FP) numwd = 2; /* fp? at least 2 */\r
366else numwd = 1; /* else at least 1 */\r
367if (ir & FI_DP) numwd = numwd + 1; /* dp? 1 more */\r
368for (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
372if (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
384else {\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
399return FP_OK;\r
400}\r
401\r
402t_stat fp15_store (int32 ir, int32 addr, UFP *a)\r
403{\r
404int32 i, numwd, wd[3];\r
405t_stat sta;\r
406\r
407fguard = 0; /* clear guard */\r
408if (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
432else {\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
453for (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
457return 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
464t_stat fp15_iadd (int32 ir, UFP *a, UFP *b, t_bool sub)\r
465{\r
466fmq.hi = fmq.lo = 0; /* clear FMQ */\r
467if (a->sign ^ b->sign ^ sub) dp_sub (a, b); /* eff subtract? */\r
468else {\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
475fp15_asign (ir, a); /* adjust A sign */\r
476return FP_OK;\r
477}\r
478\r
479/* Integer multiply - overflow if high result (FMQ after swap) non-zero */\r
480\r
481t_stat fp15_imul (int32 ir, UFP *a, UFP *b)\r
482{\r
483a->sign = a->sign ^ b->sign; /* sign of result */\r
484dp_mul (a, b); /* a'FMQ <- a * b */\r
485dp_swap (a, &fmq); /* swap a, FMQ */\r
486if (fmq.hi | fmq.lo) return FP_OVF; /* FMQ != 0? ovf */\r
487fp15_asign (ir, a); /* adjust A sign */\r
488return 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
503t_stat fp15_idiv (int32 ir, UFP *a, UFP *b)\r
504{\r
505int32 i, sc;\r
506\r
507a->sign = a->sign ^ b->sign; /* sign of result */\r
508fmq.hi = fmq.lo = 0; /* clear quotient */\r
509a->exp = 0; /* clear a exp */\r
510if ((b->hi | b->lo) == 0) return FP_DIV; /* div by 0? */\r
511if ((a->hi | a->lo) == 0) return FP_OK; /* div into 0? */\r
512while (((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
517if (!(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
521while ((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
525sc = a->exp;\r
526for (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
535dp_rsh_1 (a, NULL); /* shift back */\r
536dp_swap (a, &fmq); /* swap a, FMQ */\r
537fp15_asign (ir, a); /* adjust A sign */\r
538return 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
547t_stat fp15_fadd (int32 ir, UFP *a, UFP *b, t_bool sub)\r
548{\r
549int32 ediff;\r
550\r
551fmq.hi = fmq.lo = 0; /* clear FMQ */\r
552ediff = a->exp - b->exp; /* exp diff */\r
553if (((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
557else 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
575fp15_asign (ir, a); /* adjust A sign */\r
576return 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
581t_stat fp15_fmul (int32 ir, UFP *a, UFP *b)\r
582{\r
583a->sign = a->sign ^ b->sign; /* sign of result */\r
584a->exp = a->exp + b->exp; /* exp of result */\r
585dp_mul (a, b); /* mul fractions */\r
586fp15_asign (ir, a); /* adjust A sign */\r
587return 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
592t_stat fp15_fdiv (int32 ir, UFP *a, UFP *b)\r
593{\r
594int32 i;\r
595\r
596a->sign = a->sign ^ b->sign; /* sign of result */\r
597a->exp = a->exp - b->exp; /* exp of result */\r
598fmq.hi = fmq.lo = 0; /* clear quotient */\r
599if (!(b->hi & UFP_FH_NORM)) return FP_DIV; /* divr not norm? */\r
600if (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
614fp15_asign (ir, a); /* adjust A sign */\r
615return 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
620t_stat fp15_fix (int32 ir, UFP *a)\r
621{\r
622int32 i;\r
623\r
624fmq.hi = fmq.lo = 0; /* clear FMQ */\r
625if (a->exp > 35) return FP_OVF; /* exp > 35? ovf */\r
626if (a->exp < 0) a->hi = a->lo = 0; /* exp <0 ? rslt 0 */\r
627else {\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
635fp15_asign (ir, a); /* adjust A sign */\r
636return 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
643void dp_add (UFP *a, UFP *b)\r
644{\r
645a->lo = (a->lo + b->lo) & UFP_FL_MASK; /* add low */\r
646a->hi = a->hi + b->hi + (a->lo < b->lo); /* add hi + carry */\r
647return;\r
648}\r
649\r
650/* Double precision increment - returns 72b result (including carry) */\r
651\r
652void dp_inc (UFP *a)\r
653{\r
654a->lo = (a->lo + 1) & UFP_FL_MASK; /* inc low */\r
655a->hi = a->hi + (a->lo == 0); /* propagate carry */\r
656return;\r
657}\r
658\r
659/* Double precision subtract - result always fits in 71b */\r
660\r
661void dp_sub (UFP *a, UFP *b)\r
662{\r
663if (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
667else {\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
672return;\r
673}\r
674\r
675/* Double precision compare - returns +1 (>), 0 (=), -1 (<) */\r
676\r
677int32 dp_cmp (UFP *a, UFP *b)\r
678{\r
679if (a->hi < b->hi) return -1;\r
680if (a->hi > b->hi) return +1;\r
681if (a->lo < b->lo) return -1;\r
682if (a->lo > b->lo) return +1;\r
683return 0;\r
684}\r
685\r
686/* Double precision multiply - returns 70b result in a'fmq */\r
687\r
688void dp_mul (UFP *a, UFP *b)\r
689{\r
690int32 i;\r
691\r
692fmq.hi = a->hi; /* FMQ <- a */\r
693fmq.lo = a->lo;\r
694a->hi = a->lo = 0; /* a <- 0 */\r
695if ((fmq.hi | fmq.lo) == 0) return;\r
696if ((b->hi | b->lo) == 0) {\r
697 fmq.hi = fmq.lo = 0;\r
698 return;\r
699 }\r
700for (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
704return; \r
705}\r
706\r
707/* Double (quad) precision left shift - returns 72b (143b) result */\r
708\r
709void dp_lsh_1 (UFP *a, UFP *b)\r
710{\r
711int32 t = b? b->hi: 0;\r
712\r
713a->hi = (a->hi << 1) | ((a->lo >> 17) & 1);\r
714a->lo = ((a->lo << 1) | ((t >> 16) & 1)) & UFP_FL_MASK;\r
715if (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
719return;\r
720}\r
721\r
722/* Double (quad) precision right shift - returns 71b (142b) result */\r
723\r
724void dp_rsh_1 (UFP *a, UFP *b)\r
725{\r
726if (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
730a->lo = (a->lo >> 1) | ((a->hi & 1) << 17);\r
731a->hi = a->hi >> 1;\r
732return;\r
733}\r
734\r
735/* Double precision denormalize and round - returns 71b result */\r
736\r
737void dp_dnrm_r (int32 ir, UFP *a, int32 sc)\r
738{\r
739int32 i;\r
740\r
741if (sc <= 0) return; /* legit? */\r
742for (i = 0; i < sc; i++) dp_rsh_1 (a, &fmq); /* dnorm to fmq */\r
743if (!(ir & FI_NORND) && (fmq.hi & UFP_FH_NORM)) /* round & fmq<1>? */\r
744 dp_inc (a); /* incr a */\r
745return;\r
746}\r
747\r
748/* Double precision swap */\r
749\r
750void dp_swap (UFP *a, UFP *b)\r
751{\r
752int32 t;\r
753\r
754t = a->hi; /* swap fractions */\r
755a->hi = b->hi;\r
756b->hi = t;\r
757t = a->lo;\r
758a->lo = b->lo;\r
759b->lo = t;\r
760return;\r
761}\r
762\r
763/* Support routines */\r
764\r
765void fp15_asign (int32 fir, UFP *a)\r
766{\r
767int32 sgnop = FI_GETSGNOP (fir);\r
768\r
769switch (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
787return;\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
796t_stat fp15_norm (int32 ir, UFP *a, UFP *b, t_bool rnd)\r
797{\r
798a->hi = a->hi & UFP_FH_MASK; /* mask a */\r
799a->lo = a->lo & UFP_FL_MASK;\r
800if (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
804if (!(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
813if (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
823if (a->exp > (int32) 0377777) return FP_OVF; /* overflow? */\r
824if (a->exp < (int32) -0400000) return FP_UNF; /* underflow? */\r
825return FP_OK;\r
826}\r
827\r
828/* Exception */\r
829\r
830t_stat fp15_exc (t_stat sta)\r
831{\r
832int32 ma, mb;\r
833\r
834if (sta == FP_MM) trap_pending = 0; /* if mm, kill trap */\r
835ma = (jea & JEA_EAMASK) + sta - 1; /* JEA address */\r
836PCQ_ENTRY; /* record branch */\r
837PC = Incr_addr (PC); /* PC+1 for "JMS" */\r
838mb = Jms_word (usmd); /* form JMS word */\r
839if (Write (ma, mb, WR)) return SCPE_OK; /* store */\r
840PC = (ma + 1) & IAMASK; /* new PC */\r
841return SCPE_OK;\r
842}\r
843 \r
844/* Reset routine */\r
845\r
846t_stat fp15_reset (DEVICE *dptr)\r
847{\r
848jea = 0;\r
849fir = 0;\r
850fguard = 0;\r
851fma.exp = fma.hi = fma.lo = fma.sign = 0;\r
852fmb.exp = fmb.hi = fmb.lo = fmb.sign = 0;\r
853fmq.exp = fmq.hi = fmq.lo = fmq.sign = 0;\r
854return SCPE_OK;\r
855}\r
Magically enhanced SIMH