First Commit of my working state
[simh.git] / PDP8 / pdp8_fpp.c
1 /* pdp8_fpp.c: PDP-8 floating point processor (FPP8A)
2
3 Copyright (c) 2007, 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 FPP8A floating point processor
27
28 Floating point formats:
29
30 00 01 02 03 04 05 06 07 08 09 10 11
31 +--+--+--+--+--+--+--+--+--+--+--+--+
32 | S| hi integer | : double precision
33 +--+--+--+--+--+--+--+--+--+--+--+--+
34 | lo integer |
35 +--+--+--+--+--+--+--+--+--+--+--+--+
36
37 00 01 02 03 04 05 06 07 08 09 10 11
38 +--+--+--+--+--+--+--+--+--+--+--+--+
39 | S| exponent | : floating point
40 +--+--+--+--+--+--+--+--+--+--+--+--+
41 | S| hi fraction |
42 +--+--+--+--+--+--+--+--+--+--+--+--+
43 | lo fraction |
44 +--+--+--+--+--+--+--+--+--+--+--+--+
45
46
47 00 01 02 03 04 05 06 07 08 09 10 11
48 +--+--+--+--+--+--+--+--+--+--+--+--+
49 | S| exponent | : extended precision
50 +--+--+--+--+--+--+--+--+--+--+--+--+
51 | S| hi fraction |
52 +--+--+--+--+--+--+--+--+--+--+--+--+
53 | next fraction |
54 +--+--+--+--+--+--+--+--+--+--+--+--+
55 | next fraction |
56 +--+--+--+--+--+--+--+--+--+--+--+--+
57 | next fraction |
58 +--+--+--+--+--+--+--+--+--+--+--+--+
59 | lo fraction |
60 +--+--+--+--+--+--+--+--+--+--+--+--+
61
62 Exponents are 2's complement, as are fractions. Normalized numbers have
63 the form:
64
65 0.0...0
66 0.<non-zero>
67 1.<non-zero>
68 1.1...0
69
70 Note that 1.0...0 is normalized but considered illegal, since it cannot
71 be represented as a positive number. When a result is normalized, 1.0...0
72 is converted to 1.1...0 with exp+1.
73 */
74
75 #include "pdp8_defs.h"
76
77 extern int32 int_req;
78 extern int32 sim_switches;
79 extern int32 sim_interval;
80 extern uint16 M[];
81 extern int32 stop_inst;
82 extern UNIT cpu_unit;
83
84 #define SEXT12(x) (((x) & 04000)? (x) | ~07777: (x) & 03777)
85
86 /* Index registers are in memory */
87
88 #define fpp_read_xr(xr) fpp_read (fpp_xra + xr)
89 #define fpp_write_xr(xr,d) fpp_write (fpp_xra +xr, d)
90
91 /* Command register */
92
93 #define FPC_DP 04000 /* integer double */
94 #define FPC_UNFX 02000 /* exit on fl undf */
95 #define FPC_FIXF 01000 /* lock mem field */
96 #define FPC_IE 00400 /* int enable */
97 #define FPC_V_FAST 4 /* startup bits */
98 #define FPC_M_FAST 017
99 #define FPC_LOCK 00010 /* lockout */
100 #define FPC_V_APTF 0
101 #define FPC_M_APTF 07 /* apta field */
102 #define FPC_STA (FPC_DP|FPC_LOCK)
103 #define FPC_GETFAST(x) (((x) >> FPC_V_FAST) & FPC_M_FAST)
104 #define FPC_GETAPTF(x) (((x) >> FPC_V_APTF) & FPC_M_APTF)
105
106 /* Status register */
107
108 #define FPS_DP (FPC_DP) /* integer double */
109 #define FPS_TRPX 02000 /* trap exit */
110 #define FPS_HLTX 01000 /* halt exit */
111 #define FPS_DVZX 00400 /* div zero exit */
112 #define FPS_IOVX 00200 /* int ovf exit */
113 #define FPS_FOVX 00100 /* flt ovf exit */
114 #define FPS_UNF 00040 /* underflow */
115 #define FPS_UNFX 00020 /* undf exit */
116 #define FPS_XXXM 00010 /* FADDM/FMULM */
117 #define FPS_LOCK (FPC_LOCK) /* lockout */
118 #define FPS_EP 00004 /* ext prec */
119 #define FPS_PAUSE 00002 /* paused */
120 #define FPS_RUN 00001 /* running */
121
122 /* Floating point number: 3-6 words */
123
124 #define FPN_FRSIGN 04000
125 #define FPN_NFR_FP 2 /* std precision */
126 #define FPN_NFR_EP 5 /* ext precision */
127 #define EXACT (uint32)((fpp_sta & FPS_EP)? FPN_NFR_EP: FPN_NFR_FP)
128 #define EXTEND ((uint32) FPN_NFR_EP)
129
130 typedef struct {
131 int32 exp;
132 uint32 fr[FPN_NFR_EP];
133 } FPN;
134
135 uint32 fpp_apta; /* APT pointer */
136 uint32 fpp_aptsvf; /* APT saved field */
137 uint32 fpp_opa; /* operand pointer */
138 uint32 fpp_fpc; /* FP PC */
139 uint32 fpp_bra; /* base reg pointer */
140 uint32 fpp_xra; /* indx reg pointer */
141 uint32 fpp_cmd; /* command */
142 uint32 fpp_sta; /* status */
143 uint32 fpp_flag; /* flag */
144 FPN fpp_ac; /* FAC */
145 static FPN fpp_zero = { 0, { 0, 0, 0, 0, 0 } };
146 static FPN fpp_one = { 1, { 02000, 0, 0, 0, 0 } };
147
148 DEVICE fpp_dev;
149 int32 fpp55 (int32 IR, int32 AC);
150 int32 fpp56 (int32 IR, int32 AC);
151 void fpp_load_apt (uint32 apta);
152 void fpp_dump_apt (uint32 apta, uint32 sta);
153 uint32 fpp_1wd_dir (uint32 ir);
154 uint32 fpp_2wd_dir (uint32 ir);
155 uint32 fpp_indir (uint32 ir);
156 uint32 fpp_ad15 (uint32 hi);
157 uint32 fpp_adxr (uint32 ir, uint32 base_ad);
158 t_bool fpp_add (FPN *a, FPN *b, uint32 sub);
159 t_bool fpp_mul (FPN *a, FPN *b);
160 t_bool fpp_div (FPN *a, FPN *b);
161 t_bool fpp_imul (FPN *a, FPN *b);
162 uint32 fpp_fr_add (uint32 *c, uint32 *a, uint32 *b);
163 void fpp_fr_sub (uint32 *c, uint32 *a, uint32 *b);
164 void fpp_fr_mul (uint32 *c, uint32 *a, uint32 *b);
165 t_bool fpp_fr_div (uint32 *c, uint32 *a, uint32 *b);
166 uint32 fpp_fr_neg (uint32 *a, uint32 cnt);
167 int32 fpp_fr_cmp (uint32 *a, uint32 *b, uint32 cnt);
168 int32 fpp_fr_test (uint32 *a, uint32 v0, uint32 cnt);
169 uint32 fpp_fr_abs (uint32 *a, uint32 *b, uint32 cnt);
170 void fpp_fr_fill (uint32 *a, uint32 v, uint32 cnt);
171 void fpp_fr_lshn (uint32 *a, uint32 sc, uint32 cnt);
172 void fpp_fr_lsh12 (uint32 *a, uint32 cnt);
173 void fpp_fr_lsh1 (uint32 *a, uint32 cnt);
174 void fpp_fr_rsh1 (uint32 *a, uint32 sign, uint32 cnt);
175 void fpp_fr_algn (uint32 *a, uint32 sc, uint32 cnt);
176 t_bool fpp_cond_met (uint32 cond);
177 t_bool fpp_norm (FPN *a, uint32 cnt);
178 uint32 fpp_round (FPN *a);
179 t_bool fpp_test_xp (FPN *a);
180 void fpp_copy (FPN *a, FPN *b);
181 void fpp_zcopy (FPN *a, FPN *b);
182 void fpp_read_op (uint32 ea, FPN *a);
183 void fpp_write_op (uint32 ea, FPN *a);
184 uint32 fpp_read (uint32 ea);
185 void fpp_write (uint32 ea, uint32 val);
186 uint32 apt_read (uint32 ea);
187 void apt_write (uint32 ea, uint32 val);
188 t_stat fpp_svc (UNIT *uptr);
189 t_stat fpp_reset (DEVICE *dptr);
190
191 /* FPP data structures
192
193 fpp_dev FPP device descriptor
194 fpp_unit FPP unit descriptor
195 fpp_reg FPP register list
196 */
197
198 DIB fpp_dib = { DEV_FPP, 2, { &fpp55, &fpp56 } };
199
200 UNIT fpp_unit = { UDATA (&fpp_svc, 0, 0) };
201
202 REG fpp_reg[] = {
203 { ORDATA (FPACE, fpp_ac.exp, 12) },
204 { ORDATA (FPAC0, fpp_ac.fr[0], 12) },
205 { ORDATA (FPAC1, fpp_ac.fr[1], 12) },
206 { ORDATA (FPAC2, fpp_ac.fr[2], 12) },
207 { ORDATA (FPAC3, fpp_ac.fr[3], 12) },
208 { ORDATA (FPAC4, fpp_ac.fr[4], 12) },
209 { ORDATA (CMD, fpp_cmd, 12) },
210 { ORDATA (STA, fpp_sta, 12) },
211 { ORDATA (APTA, fpp_apta, 15) },
212 { GRDATA (APTSVF, fpp_aptsvf, 8, 3, 12) },
213 { ORDATA (FPC, fpp_fpc, 15) },
214 { ORDATA (BRA, fpp_bra, 15) },
215 { ORDATA (XRA, fpp_xra, 15) },
216 { ORDATA (OPA, fpp_opa, 15) },
217 { FLDATA (FLAG, fpp_flag, 0) },
218 { NULL }
219 };
220
221 DEVICE fpp_dev = {
222 "FPP", &fpp_unit, fpp_reg, NULL,
223 1, 10, 31, 1, 8, 8,
224 NULL, NULL, &fpp_reset,
225 NULL, NULL, NULL,
226 &fpp_dib, DEV_DISABLE | DEV_DIS
227 };
228
229 /* IOT routines */
230
231 int32 fpp55 (int32 IR, int32 AC)
232 {
233 switch (IR & 07) { /* decode IR<9:11> */
234
235 case 1: /* FPINT */
236 return (fpp_flag? IOT_SKP | AC: AC); /* skip on flag */
237
238 case 2: /* FPICL */
239 fpp_reset (&fpp_dev); /* reset device */
240 break;
241
242 case 3: /* FPCOM */
243 if (!fpp_flag && !(fpp_sta & FPS_RUN)) { /* flag clr, !run? */
244 fpp_cmd = AC; /* load cmd */
245 fpp_sta = (fpp_sta & ~FPC_STA) | /* copy flags */
246 (fpp_cmd & FPC_STA); /* to status */
247 }
248 break;
249
250 case 4: /* FPHLT */
251 if (fpp_sta & FPS_RUN) { /* running? */
252 if (fpp_sta & FPS_PAUSE) /* paused? */
253 fpp_fpc = (fpp_fpc - 1) & ADDRMASK; /* decr FPC */
254 sim_cancel (&fpp_unit); /* stop execution */
255 fpp_dump_apt (fpp_apta, FPS_HLTX); /* dump APT */
256 }
257 else sim_activate (&fpp_unit, 0); /* single step */
258 break;
259
260 case 5: /* FPST */
261 if (!fpp_flag && !(fpp_sta & FPS_RUN)) { /* flag clr, !run? */
262 fpp_apta = (FPC_GETAPTF (fpp_cmd) << 12) | AC;
263 fpp_load_apt (fpp_apta); /* load APT */
264 sim_activate (&fpp_unit, 0); /* start unit */
265 return IOT_SKP | AC;
266 }
267 if ((fpp_sta & (FPS_RUN|FPS_PAUSE)) == (FPS_RUN|FPS_PAUSE)) {
268 fpp_sta &= ~FPS_PAUSE; /* continue */
269 sim_activate (&fpp_unit, 0); /* start unit */
270 return (IOT_SKP | AC);
271 }
272 break;
273
274 case 6: /* FPRST */
275 return fpp_sta;
276
277 case 7: /* FPIST */
278 if (fpp_flag) { /* if flag set */
279 uint32 old_sta = fpp_sta;
280 fpp_flag = 0; /* clr flag, status */
281 fpp_sta = 0;
282 int_req &= ~INT_FPP; /* clr int req */
283 return IOT_SKP | old_sta; /* ret old status */
284 }
285 break;
286
287 default:
288 return (stop_inst << IOT_V_REASON) | AC;
289 } /* end switch */
290
291 return AC;
292 }
293
294 int32 fpp56 (int32 IR, int32 AC)
295 {
296 switch (IR & 07) { /* decode IR<9:11> */
297
298 case 7: /* FPEP */
299 if ((AC & 04000) && !(fpp_sta & FPS_RUN)) /* if AC0, not run, */
300 fpp_sta = (fpp_sta | FPS_EP) & ~FPS_DP; /* set ep */
301 break;
302
303 default:
304 return (stop_inst << IOT_V_REASON) | AC;
305 } /* end switch */
306
307 return AC;
308 }
309
310 /* Service routine */
311
312 t_stat fpp_svc (UNIT *uptr)
313 {
314 FPN x;
315 uint32 ir, op, op2, op3, ad, ea, wd;
316 uint32 i;
317
318 fpp_ac.exp = SEXT12 (fpp_ac.exp); /* sext AC exp */
319 do { /* repeat */
320 ir = fpp_read (fpp_fpc); /* get instr */
321 fpp_fpc = (fpp_fpc + 1) & ADDRMASK; /* incr FP PC */
322 op = (ir >> 7) & 037; /* get op+mode */
323 op2 = (ir >> 3) & 017; /* get subop */
324 op3 = ir & 07; /* get field/xr */
325 fpp_sta &= ~FPS_XXXM; /* not mem op */
326
327 switch (op) { /* case on op+mode */
328 case 000: /* operates */
329
330 switch (op2) { /* case on subop */
331 case 000: /* no-operands */
332 switch (op3) { /* case on subsubop */
333
334 case 0: /* FEXIT */
335 fpp_dump_apt (fpp_apta, 0);
336 break;
337
338 case 1: /* FPAUSE */
339 fpp_sta |= FPS_PAUSE;
340 break;
341
342 case 2: /* FCLA */
343 fpp_copy (&fpp_ac, &fpp_zero); /* clear FAC */
344 break;
345
346 case 3: /* FNEG */
347 fpp_fr_neg (fpp_ac.fr, EXACT); /* do exact length */
348 break;
349
350 case 4: /* FNORM */
351 if (!(fpp_sta & FPS_DP)) { /* fp or ep only */
352 fpp_copy (&x, &fpp_ac); /* copy AC */
353 fpp_norm (&x, EXACT); /* do exact length */
354 if (!fpp_test_xp (&x)) /* no trap? */
355 fpp_copy (&fpp_ac, &x); /* copy back */
356 }
357 break;
358
359 case 5: /* STARTF */
360 if (fpp_sta & FPS_EP) { /* if ep, */
361 fpp_copy (&x, &fpp_ac); /* copy AC */
362 fpp_round (&x); /* round */
363 if (!fpp_test_xp (&x)) /* no trap? */
364 fpp_copy (&fpp_ac, &x); /* copy back */
365 }
366 fpp_sta &= ~(FPS_DP|FPS_EP);
367 break;
368
369 case 6: /* STARTD */
370 fpp_sta = (fpp_sta | FPS_DP) & ~FPS_EP;
371 break;
372
373 case 7: /* JAC */
374 fpp_fpc = ((fpp_ac.fr[0] & 07) << 12) | fpp_ac.fr[1];
375 break;
376 }
377 break;
378
379 case 001: /* ALN */
380 if (op3 != 0) /* if xr, */
381 wd = fpp_read_xr (op3); /* use val */
382 else wd = 027; /* else 23 */
383 if (!(fpp_sta & FPS_DP)) { /* fp or ep? */
384 int32 t = wd - fpp_ac.exp; /* alignment */
385 fpp_ac.exp = SEXT12 (wd); /* new exp */
386 wd = t & 07777;
387 }
388 if (wd & 04000) /* left? */
389 fpp_fr_lshn (fpp_ac.fr, 04000 - wd, EXACT);
390 else fpp_fr_algn (fpp_ac.fr, wd, EXACT);
391 break;
392
393 case 002: /* ATX */
394 if (fpp_sta & FPS_DP) /* dp? */
395 fpp_write_xr (op3, fpp_ac.fr[1]); /* xr<-FAC<12:23> */
396 else {
397 fpp_copy (&x, &fpp_ac); /* copy AC */
398 wd = (fpp_ac.exp - 027) & 07777; /* shift amt */
399 if (wd & 04000) /* left? */
400 fpp_fr_lshn (x.fr, 04000 - wd, EXACT);
401 else fpp_fr_algn (x.fr, wd, EXACT);
402 fpp_write_xr (op3, x.fr[1]); /* xr<-val<12:23> */
403 }
404 break;
405
406 case 003: /* XTA */
407 for (i = FPN_NFR_FP; i < FPN_NFR_EP; i++)
408 x.fr[i] = 0; /* clear FOP2-4 */
409 x.fr[1] = fpp_read_xr (op3); /* get XR value */
410 x.fr[0] = (x.fr[1] & 04000)? 07777: 0;
411 x.exp = 027; /* standard exp */
412 if (!(fpp_sta & FPS_DP)) { /* fp or ep? */
413 fpp_norm (&x, EXACT); /* normalize */
414 if (fpp_test_xp (&x)) /* exception? */
415 break;
416 }
417 fpp_copy (&fpp_ac, &x); /* result to AC */
418 break;
419
420 case 004: /* NOP */
421 break;
422
423 case 005: /* STARTE */
424 if (!(fpp_sta & FPS_EP)) {
425 fpp_sta = (fpp_sta | FPS_EP) & ~FPS_DP;
426 for (i = FPN_NFR_FP; i < FPN_NFR_EP; i++)
427 fpp_ac.fr[i] = 0; /* clear FAC2-4 */
428 }
429 break;
430
431 case 010: /* LDX */
432 wd = fpp_ad15 (0); /* load XR immed */
433 fpp_write_xr (op3, wd);
434 break;
435
436 case 011: /* ADDX */
437 wd = fpp_ad15 (0);
438 wd = wd + fpp_read_xr (op3); /* add to XR immed */
439 fpp_write_xr (op3, wd); /* trims to 12b */
440 break;
441
442 default:
443 return stop_inst;
444 } /* end case subop */
445 break;
446
447 case 001: /* FLDA */
448 ea = fpp_1wd_dir (ir);
449 fpp_read_op (ea, &fpp_ac);
450 break;
451
452 case 002:
453 ea = fpp_2wd_dir (ir);
454 fpp_read_op (ea, &fpp_ac);
455 break;
456
457 case 003:
458 ea = fpp_indir (ir);
459 fpp_read_op (ea, &fpp_ac);
460 break;
461
462 case 004: /* jumps and sets */
463 ad = fpp_ad15 (op3); /* get 15b address */
464 switch (op2) { /* case on subop */
465
466 case 000: case 001: case 002: case 003: /* cond jump */
467 case 004: case 005: case 006: case 007:
468 if (fpp_cond_met (op2)) /* br if cond */
469 fpp_fpc = ad;
470 break;
471
472 case 010: /* SETX */
473 fpp_xra = ad;
474 break;
475
476 case 011: /* SETB */
477 fpp_bra = ad;
478 break;
479
480 case 012: /* JSA */
481 fpp_write (ad, 01030 + (fpp_fpc >> 12)); /* save return */
482 fpp_write (ad + 1, fpp_fpc); /* trims to 12b */
483 fpp_fpc = (ad + 2) & ADDRMASK;
484 break;
485
486 case 013: /* JSR */
487 fpp_write (fpp_bra + 1, 01030 + (fpp_fpc >> 12));
488 fpp_write (fpp_bra + 2, fpp_fpc); /* trims to 12b */
489 fpp_fpc = ad;
490 break;
491
492 default:
493 return stop_inst;
494 } /* end case subop */
495 break;
496
497 case 005: /* FADD */
498 ea = fpp_1wd_dir (ir);
499 fpp_read_op (ea, &x);
500 fpp_add (&fpp_ac, &x, 0);
501 break;
502
503 case 006:
504 ea = fpp_2wd_dir (ir);
505 fpp_read_op (ea, &x);
506 fpp_add (&fpp_ac, &x, 0);
507 break;
508
509 case 007:
510 ea = fpp_indir (ir);
511 fpp_read_op (ea, &x);
512 fpp_add (&fpp_ac, &x, 0);
513 break;
514
515 case 010: /* JNX */
516 ad = fpp_ad15 (op3); /* get 15b addr */
517 wd = fpp_read_xr (op2 & 07); /* read xr */
518 if (ir & 00100) { /* inc? */
519 wd = (wd + 1) & 07777;
520 fpp_write_xr (op2 & 07, wd); /* ++xr */
521 }
522 if (wd != 0) /* xr != 0? */
523 fpp_fpc = ad; /* jump */
524 break;
525
526 case 011: /* FSUB */
527 ea = fpp_1wd_dir (ir);
528 fpp_read_op (ea, &x);
529 fpp_add (&fpp_ac, &x, 1);
530 break;
531
532 case 012:
533 ea = fpp_2wd_dir (ir);
534 fpp_read_op (ea, &x);
535 fpp_add (&fpp_ac, &x, 1);
536 break;
537
538 case 013:
539 ea = fpp_indir (ir);
540 fpp_read_op (ea, &x);
541 fpp_add (&fpp_ac, &x, 1);
542 break;
543
544 case 014: /* TRAP3 */
545 case 020: /* TRAP4 */
546 fpp_opa = fpp_ad15 (op3);
547 fpp_dump_apt (fpp_apta, FPS_TRPX);
548 break;
549
550 case 015: /* FDIV */
551 ea = fpp_1wd_dir (ir);
552 fpp_read_op (ea, &x);
553 fpp_div (&fpp_ac, &x);
554 break;
555
556 case 016:
557 ea = fpp_2wd_dir (ir);
558 fpp_read_op (ea, &x);
559 fpp_div (&fpp_ac, &x);
560 break;
561
562 case 017:
563 ea = fpp_indir (ir);
564 fpp_read_op (ea, &x);
565 fpp_div (&fpp_ac, &x);
566 break;
567
568 case 021: /* FMUL */
569 ea = fpp_1wd_dir (ir);
570 fpp_read_op (ea, &x);
571 fpp_mul (&fpp_ac, &x);
572 break;
573
574 case 022:
575 ea = fpp_2wd_dir (ir);
576 fpp_read_op (ea, &x);
577 fpp_mul (&fpp_ac, &x);
578 break;
579
580 case 023:
581 ea = fpp_indir (ir);
582 fpp_read_op (ea, &x);
583 fpp_mul (&fpp_ac, &x);
584 break;
585
586 case 024: /* LTR */
587 fpp_copy (&fpp_ac, (fpp_cond_met (op2 & 07)? &fpp_one: &fpp_zero));
588 break;
589
590 case 025: /* FADDM */
591 fpp_sta |= FPS_XXXM;
592 ea = fpp_1wd_dir (ir);
593 fpp_read_op (ea, &x);
594 if (!fpp_add (&x, &fpp_ac, 0)) /* no trap? */
595 fpp_write_op (ea, &x); /* store result */
596 break;
597
598 case 026:
599 fpp_sta |= FPS_XXXM;
600 ea = fpp_2wd_dir (ir);
601 fpp_read_op (ea, &x);
602 if (!fpp_add (&x, &fpp_ac, 0)) /* no trap? */
603 fpp_write_op (ea, &x); /* store result */
604 break;
605
606 case 027:
607 fpp_sta |= FPS_XXXM;
608 ea = fpp_indir (ir);
609 fpp_read_op (ea, &x);
610 if (!fpp_add (&x, &fpp_ac, 0)) /* no trap? */
611 fpp_write_op (ea, &x); /* store result */
612 break;
613
614 case 030: /* IMUL/LEA */
615 ea = fpp_2wd_dir (ir); /* 2-word direct */
616 if (fpp_sta & FPS_DP) { /* dp? */
617 fpp_read_op (ea, &x); /* IMUL */
618 fpp_imul (&fpp_ac, &x);
619 }
620 else { /* LEA */
621 fpp_sta = (fpp_sta | FPS_DP) & ~FPS_EP; /* set dp */
622 fpp_ac.fr[0] = (ea >> 12) & 07;
623 fpp_ac.fr[1] = ea & 07777;
624 }
625 break;
626
627 case 031: /* FSTA */
628 ea = fpp_1wd_dir (ir);
629 fpp_write_op (ea, &fpp_ac);
630 break;
631
632 case 032:
633 ea = fpp_2wd_dir (ir);
634 fpp_write_op (ea, &fpp_ac);
635 break;
636
637 case 033:
638 ea = fpp_indir (ir);
639 fpp_write_op (ea, &fpp_ac);
640 break;
641
642 case 034: /* IMULI/LEAI */
643 ea = fpp_indir (ir); /* 1-word indir */
644 if (fpp_sta & FPS_DP) { /* dp? */
645 fpp_read_op (ea, &x); /* IMUL */
646 fpp_imul (&fpp_ac, &x);
647 }
648 else { /* LEA */
649 fpp_sta = (fpp_sta | FPS_DP) & ~FPS_EP; /* set dp */
650 fpp_ac.fr[0] = (ea >> 12) & 07;
651 fpp_ac.fr[1] = ea & 07777;
652 }
653 break;
654
655 case 035: /* FMULM */
656 fpp_sta |= FPS_XXXM;
657 ea = fpp_1wd_dir (ir);
658 fpp_read_op (ea, &x);
659 if (!fpp_mul (&x, &fpp_ac)) /* no trap? */
660 fpp_write_op (ea, &x); /* store result */
661 break;
662
663 case 036:
664 fpp_sta |= FPS_XXXM;
665 ea = fpp_2wd_dir (ir);
666 fpp_read_op (ea, &x);
667 if (!fpp_mul (&x, &fpp_ac)) /* no trap? */
668 fpp_write_op (ea, &x); /* store result */
669 break;
670
671 case 037:
672 fpp_sta |= FPS_XXXM;
673 ea = fpp_indir (ir);
674 fpp_read_op (ea, &x);
675 if (!fpp_mul (&x, &fpp_ac)) /* no trap? */
676 fpp_write_op (ea, &x); /* store result */
677 break;
678 } /* end sw op+mode */
679
680 if (sim_interval)
681 sim_interval = sim_interval - 1;
682 } while ((sim_interval > 0) &&
683 ((fpp_sta & (FPS_RUN|FPS_PAUSE|FPS_LOCK)) == (FPS_RUN|FPS_LOCK)));
684 if ((fpp_sta & (FPS_RUN|FPS_PAUSE)) == FPS_RUN)
685 sim_activate (uptr, 1);
686 fpp_ac.exp &= 07777; /* mask AC exp */
687 return SCPE_OK;
688 }
689
690 /* Address decoding routines */
691
692 uint32 fpp_1wd_dir (uint32 ir)
693 {
694 uint32 ad;
695
696 ad = fpp_bra + ((ir & 0177) * 3); /* base + 3*7b off */
697 if (fpp_sta & FPS_DP) /* dp? skip exp */
698 ad = ad + 1;
699 return ad & ADDRMASK;
700 }
701
702 uint32 fpp_2wd_dir (uint32 ir)
703 {
704 uint32 ad;
705
706 ad = fpp_ad15 (ir); /* get 15b addr */
707 return fpp_adxr (ir, ad); /* do indexing */
708 }
709
710 uint32 fpp_indir (uint32 ir)
711 {
712 uint32 ad, iad, wd1, wd2;
713
714 ad = fpp_bra + ((ir & 07) * 3); /* base + 3*3b off */
715 iad = fpp_adxr (ir, ad); /* do indexing */
716 wd1 = fpp_read (iad + 1); /* read wds 2,3 */
717 wd2 = fpp_read (iad + 2);
718 return ((wd1 & 07) << 12) | wd2; /* return addr */
719 }
720
721 uint32 fpp_ad15 (uint32 hi)
722 {
723 uint32 ad;
724
725 ad = ((hi & 07) << 12) | fpp_read (fpp_fpc); /* 15b addr */
726 fpp_fpc = (fpp_fpc + 1) & ADDRMASK; /* incr FPC */
727 return ad; /* return addr */
728 }
729
730 uint32 fpp_adxr (uint32 ir, uint32 base_ad)
731 {
732 uint32 xr, wd;
733
734 xr = (ir >> 3) & 07;
735 wd = fpp_read_xr (xr); /* get xr */
736 if (ir & 0100) { /* increment? */
737 wd = (wd + 1) & 07777; /* inc, rewrite */
738 fpp_write_xr (xr, wd);
739 }
740 if (xr != 0) { /* indexed? */
741 if (fpp_sta & FPS_EP) wd = wd * 6; /* scale by len */
742 else if (fpp_sta & FPS_DP) wd = wd * 2;
743 else wd = wd * 3;
744 return (base_ad + wd) & ADDRMASK; /* return index */
745 }
746 else return base_ad & ADDRMASK; /* return addr */
747 }
748
749 /* Computation routines */
750
751 /* Fraction/floating add - return true if overflow */
752
753 t_bool fpp_add (FPN *a, FPN *b, uint32 sub)
754 {
755 FPN x, y, z;
756 uint32 ediff, c;
757
758 fpp_zcopy (&x, a); /* copy opnds */
759 fpp_zcopy (&y, b);
760 if (sub) /* subtract? */
761 fpp_fr_neg (y.fr, EXACT); /* neg B, exact */
762 if (fpp_sta & FPS_DP) { /* dp? */
763 fpp_fr_add (z.fr, x.fr, y.fr); /* z = a + b */
764 if ((~x.fr[0] ^ y.fr[0]) & (x.fr[0] ^ z.fr[0]) & FPN_FRSIGN) {
765 fpp_dump_apt (fpp_apta, FPS_IOVX); /* int ovf? */
766 return TRUE;
767 }
768 }
769 else { /* fp or ep */
770 if (fpp_fr_test (b->fr, 0, EXACT) == 0) /* B == 0? */
771 z = x; /* result is A */
772 else if (fpp_fr_test (a->fr, 0, EXACT) == 0) /* A == 0? */
773 z = y; /* result is B */
774 else { /* fp or ep */
775 if (x.exp < y.exp) { /* |a| < |b|? */
776 z = x; /* exchange ops */
777 x = y;
778 y = z;
779 }
780 ediff = x.exp - y.exp; /* exp diff */
781 z.exp = x.exp; /* result exp */
782 if (ediff <= (fpp_sta & FPS_EP)? 59: 24) { /* any add? */
783 if (ediff != 0) /* any align? */
784 fpp_fr_algn (y.fr, ediff, EXTEND); /* align, 60b */
785 c = fpp_fr_add (z.fr, x.fr, y.fr); /* add fractions */
786 if ((((x.fr[0] ^ y.fr[0]) & FPN_FRSIGN) == 0) && /* same signs? */
787 (c || /* carry out? */
788 ((~x.fr[0] & z.fr[0] & FPN_FRSIGN)))) { /* + to - change? */
789 fpp_fr_rsh1 (z.fr, c << 11, EXTEND); /* rsh, insert cout */
790 z.exp = z.exp + 1; /* incr exp */
791 } /* end same signs */
792 } /* end in range */
793 } /* end ops != 0 */
794 if (fpp_norm (&z, EXTEND)) /* norm, !exact? */
795 fpp_round (&z); /* round */
796 if (fpp_test_xp (&z)) /* ovf, unf? */
797 return TRUE;
798 } /* end else */
799 fpp_copy (a, &z); /* result is z */
800 return FALSE;
801 }
802
803 /* Fraction/floating multiply - return true if overflow */
804
805 t_bool fpp_mul (FPN *a, FPN *b)
806 {
807 FPN x, y, z;
808
809 fpp_zcopy (&x, a); /* copy opnds */
810 fpp_zcopy (&y, b);
811 if (fpp_sta & FPS_DP) /* dp? */
812 fpp_fr_mul (z.fr, x.fr, y.fr); /* mult frac */
813 else { /* fp or ep */
814 z.exp = x.exp + y.exp; /* add exp */
815 fpp_fr_mul (z.fr, x.fr, y.fr); /* mult frac */
816 if (fpp_norm (&z, EXTEND)) /* norm, !exact? */
817 fpp_round (&z); /* round */
818 if (fpp_test_xp (&z)) /* ovf, unf? */
819 return TRUE;
820 }
821 fpp_copy (a, &z); /* result is z */
822 return FALSE;
823 }
824
825 /* Fraction/floating divide - return true if div by zero or overflow */
826
827 t_bool fpp_div (FPN *a, FPN *b)
828 {
829 FPN x, y, z;
830
831 if (fpp_fr_test (b->fr, 0, EXACT) == 0) { /* divisor 0? */
832 fpp_dump_apt (fpp_apta, FPS_DVZX); /* error */
833 return TRUE;
834 }
835 if (fpp_fr_test (a->fr, 0, EXACT) == 0) /* dividend 0? */
836 return FALSE; /* quotient is 0 */
837 fpp_zcopy (&x, a); /* copy opnds */
838 fpp_zcopy (&y, b);
839 if (fpp_sta & FPS_DP) { /* dp? */
840 if (fpp_fr_div (z.fr, x.fr, y.fr)) { /* fr div, ovflo? */
841 fpp_dump_apt (fpp_apta, FPS_IOVX); /* error */
842 return TRUE;
843 }
844 }
845 else { /* fp or ep */
846 fpp_norm (&y, EXACT); /* norm divisor */
847 if (fpp_fr_test (x.fr, 04000, EXACT) == 0) { /* divd 1.000...? */
848 x.fr[0] = 06000; /* fix */
849 x.exp = x.exp + 1;
850 }
851 z.exp = x.exp - y.exp; /* calc exp */
852 if (fpp_fr_div (z.fr, x.fr, y.fr)) { /* fr div, ovflo? */
853 uint32 cin = (a->fr[0] ^ b->fr[0]) & FPN_FRSIGN;
854 fpp_fr_rsh1 (z.fr, cin, EXTEND); /* rsh, insert sign */
855 z.exp = z.exp + 1; /* incr exp */
856 }
857 if (fpp_norm (&z, EXTEND)) /* norm, !exact? */
858 fpp_round (&z); /* round */
859 if (fpp_test_xp (&z)) /* ovf, unf? */
860 return TRUE;
861 }
862 fpp_copy (a, &z); /* result is z */
863 return FALSE;
864 }
865
866 /* Integer multiply - returns true if overflow */
867
868 t_bool fpp_imul (FPN *a, FPN *b)
869 {
870 uint32 sext;
871 FPN x, y, z;
872
873 fpp_zcopy (&x, a); /* copy args */
874 fpp_zcopy (&y, b);
875 fpp_fr_mul (z.fr, x.fr, y.fr); /* mult fracs */
876 sext = (z.fr[2] & FPN_FRSIGN)? 07777: 0;
877 if (((z.fr[0] | z.fr[1] | sext) != 0) && /* hi 25b == 0 */
878 ((z.fr[0] & z.fr[1] & sext) != 07777)) { /* or 777777774? */
879 fpp_dump_apt (fpp_apta, FPS_IOVX);
880 return TRUE;
881 }
882 a->fr[0] = z.fr[2]; /* low 24b */
883 a->fr[1] = z.fr[3];
884 return FALSE;
885 }
886
887 /* Auxiliary floating point routines */
888
889 t_bool fpp_cond_met (uint32 cond)
890 {
891 switch (cond) {
892
893 case 0:
894 return (fpp_fr_test (fpp_ac.fr, 0, EXACT) == 0);
895
896 case 1:
897 return (fpp_fr_test (fpp_ac.fr, 0, EXACT) >= 0);
898
899 case 2:
900 return (fpp_fr_test (fpp_ac.fr, 0, EXACT) <= 0);
901
902 case 3:
903 return 1;
904
905 case 4:
906 return (fpp_fr_test (fpp_ac.fr, 0, EXACT) != 0);
907
908 case 5:
909 return (fpp_fr_test (fpp_ac.fr, 0, EXACT) < 0);
910
911 case 6:
912 return (fpp_fr_test (fpp_ac.fr, 0, EXACT) > 0);
913
914 case 7:
915 return (fpp_ac.exp > 027);
916 }
917 return 0;
918 }
919
920 /* Normalization - returns TRUE if rounding possible, FALSE if exact */
921
922 t_bool fpp_norm (FPN *a, uint32 cnt)
923 {
924 if (fpp_fr_test (a->fr, 0, cnt) == 0) { /* zero? */
925 a->exp = 0; /* clean exp */
926 return FALSE; /* don't round */
927 }
928 while (((a->fr[0] == 0) && !(a->fr[1] & 04000)) || /* lead 13b same? */
929 ((a->fr[0] = 07777) & (a->fr[1] & 04000))) {
930 fpp_fr_lsh12 (a->fr, cnt); /* move word */
931 a->exp = a->exp - 12;
932 }
933 while (((a->fr[0] ^ (a->fr[0] << 1)) & FPN_FRSIGN) == 0) { /* until norm */
934 fpp_fr_lsh1 (a->fr, cnt); /* shift 1b */
935 a->exp = a->exp - 1;
936 }
937 if (fpp_fr_test (a->fr, 04000, EXACT) == 0) { /* 4000...0000? */
938 a->fr[0] = 06000; /* chg to 6000... */
939 a->exp = a->exp + 1; /* with exp+1 */
940 return FALSE; /* don't round */
941 }
942 return TRUE;
943 }
944
945 /* Exact fp number copy */
946
947 void fpp_copy (FPN *a, FPN *b)
948 {
949 uint32 i;
950
951 if (!(fpp_sta & FPS_DP))
952 a->exp = b->exp;
953 for (i = 0; i < EXACT; i++)
954 a->fr[i] = b->fr[i];
955 return;
956 }
957
958 /* Zero extended fp number copy (60b) */
959
960 void fpp_zcopy (FPN *a, FPN *b)
961 {
962 uint32 i;
963
964 a->exp = b->exp;
965 for (i = 0; i < FPN_NFR_EP; i++) {
966 if ((i < FPN_NFR_FP) || (fpp_sta & FPS_EP))
967 a->fr[i] = b->fr[i];
968 else a->fr[i] = 0;
969 }
970 return;
971 }
972
973 /* Test exp for overflow or underflow, returns TRUE on trap */
974
975 t_bool fpp_test_xp (FPN *a)
976 {
977 if (a->exp > 2047) { /* overflow? */
978 fpp_dump_apt (fpp_apta, FPS_FOVX); /* trap */
979 return TRUE;
980 }
981 if (a->exp < -2048) { /* underflow? */
982 fpp_sta |= FPS_UNF; /* set flag */
983 if (fpp_sta & FPS_UNFX) { /* trap? */
984 fpp_dump_apt (fpp_apta, FPS_UNFX);
985 return TRUE;
986 }
987 fpp_copy (a, &fpp_zero); /* flush to 0 */
988 }
989 return FALSE;
990 }
991
992 /* Round dp/fp value, returns carry out */
993
994 uint32 fpp_round (FPN *a)
995 {
996 int32 i;
997 uint32 cin, afr0_sign;
998
999 if (fpp_sta & FPS_EP) /* ep? */
1000 return FALSE; /* don't round */
1001 afr0_sign = a->fr[0] & FPN_FRSIGN; /* save input sign */
1002 cin = afr0_sign? 03777: 04000;
1003 for (i = FPN_NFR_FP; i >= 0; i--) { /* 3 words */
1004 a->fr[i] = a->fr[i] + cin; /* add in carry */
1005 cin = (a->fr[i] >> 12) & 1;
1006 a->fr[i] = a->fr[i] & 07777;
1007 }
1008 if (!(fpp_sta & FPS_DP) && /* fp? */
1009 (afr0_sign ^ (a->fr[0] & FPN_FRSIGN))) { /* sign change? */
1010 fpp_fr_rsh1 (a->fr, afr0_sign, EXACT); /* rsh, insert sign */
1011 a->exp = a->exp + 1;
1012 }
1013 return cin;
1014 }
1015
1016 /* N-precision integer routines */
1017
1018 /* Fraction add/sub - always carried out to 60b */
1019
1020 uint32 fpp_fr_add (uint32 *c, uint32 *a, uint32 *b)
1021 {
1022 uint32 i, cin;
1023
1024 for (i = FPN_NFR_EP, cin = 0; i > 0; i--) {
1025 c[i - 1] = a[i - 1] + b[i - 1] + cin;
1026 cin = (c[i - 1] >> 12) & 1;
1027 c[i - 1] = c[i - 1] & 07777;
1028 }
1029 return cin;
1030 }
1031
1032 void fpp_fr_sub (uint32 *c, uint32 *a, uint32 *b)
1033 {
1034 uint32 i, cin;
1035
1036 for (i = FPN_NFR_EP, cin = 0; i > 0; i--) {
1037 c[i - 1] = a[i - 1] - b[i - 1] - cin;
1038 cin = (c[i - 1] >> 12) & 1;
1039 c[i - 1] = c[i - 1] & 07777;
1040 }
1041 return;
1042 }
1043
1044 /* Fraction multiply - always develop 60b, multiply is
1045 either 24b*24b or 60b*60b
1046
1047 This is a signed multiply. The shift in for signed multiply is
1048 technically ALU_N XOR ALU_V. This can be simplified as follows:
1049
1050 a-sign c-sign result-sign cout overflow N XOR V = shift in
1051
1052 0 0 0 0 0 0
1053 0 0 1 0 1 0
1054 0 1 0 1 0 0
1055 0 1 1 0 0 1
1056 1 0 0 1 0 0
1057 1 0 1 0 0 1
1058 1 1 0 1 1 1
1059 1 1 1 1 0 1
1060
1061 If a-sign == c-sign, shift-in = a-sign
1062 If a-sign != c-sign, shift-in = result-sign
1063 */
1064
1065 void fpp_fr_mul (uint32 *c, uint32 *a, uint32 *b)
1066 {
1067 uint32 i, cnt, lo, c_old, cin;
1068
1069 fpp_fr_fill (c, 0, EXTEND); /* clr answer */
1070 if (fpp_sta & FPS_EP) /* ep? */
1071 lo = FPN_NFR_EP - 1; /* test <59> */
1072 else lo = FPN_NFR_FP - 1; /* sp, test <23> */
1073 cnt = (lo + 1) * 12; /* # iterations */
1074 for (i = 0; i < cnt; i++) { /* loop thru mpcd */
1075 c_old = c[0];
1076 if (b[lo] & 1) /* mpcd bit set? */
1077 fpp_fr_add (c, a, c); /* add mpyr */
1078 cin = (((a[0] ^ c_old) & FPN_FRSIGN)? c[0]: a[0]) & FPN_FRSIGN;
1079 fpp_fr_rsh1 (c, cin, EXTEND); /* shift answer */
1080 fpp_fr_rsh1 (b, 0, EXACT); /* shift mpcd */
1081 }
1082 if (a[0] & FPN_FRSIGN) /* mpyr negative? */
1083 fpp_fr_sub (c, c, a); /* adjust result */
1084 return;
1085 }
1086
1087 /* Fraction divide */
1088
1089 t_bool fpp_fr_div (uint32 *c, uint32 *a, uint32 *b)
1090 {
1091 uint32 i, old_c, lo, cnt, sign;
1092
1093 fpp_fr_fill (c, 0, EXTEND); /* clr answer */
1094 sign = (a[0] ^ b[0]) & FPN_FRSIGN; /* sign of result */
1095 if (a[0] & FPN_FRSIGN) /* |a| */
1096 fpp_fr_neg (a, EXACT);
1097 if (b[0] & FPN_FRSIGN); /* |b| */
1098 fpp_fr_neg (b, EXACT);
1099 if (fpp_sta & FPS_EP) /* ep? 5 words */
1100 lo = FPN_NFR_EP - 1;
1101 else lo = FPN_NFR_FP; /* fp, dp? 3 words */
1102 cnt = (lo + 1) * 12;
1103 for (i = 0; i < cnt; i++) { /* loop */
1104 fpp_fr_lsh1 (c, EXTEND); /* shift quotient */
1105 if (fpp_fr_cmp (a, b, EXTEND) >= 0) { /* sub work? */
1106 fpp_fr_sub (a, a, b); /* divd - divr */
1107 if (a[0] & FPN_FRSIGN) /* sign flip? */
1108 return TRUE; /* no, overflow */
1109 c[lo] |= 1; /* set quo bit */
1110 }
1111 fpp_fr_lsh1 (a, EXTEND); /* shift dividend */
1112 }
1113 old_c = c[0]; /* save ho quo */
1114 if (sign) /* expect neg ans? */
1115 fpp_fr_neg (c, EXTEND); /* -quo */
1116 if (old_c & FPN_FRSIGN) /* sign set before */
1117 return TRUE; /* neg? */
1118 return FALSE;
1119 }
1120
1121 /* Negate - 24b or 60b */
1122
1123 uint32 fpp_fr_neg (uint32 *a, uint32 cnt)
1124 {
1125 uint32 i, cin;
1126
1127 for (i = cnt, cin = 1; i > 0; i--) {
1128 a[i - 1] = (~a[i - 1] + cin) & 07777;
1129 cin = (a[i - 1] == 0);
1130 }
1131 return cin;
1132 }
1133
1134 /* Test (compare to x'0...0) - 24b or 60b */
1135
1136 int32 fpp_fr_test (uint32 *a, uint32 v0, uint32 cnt)
1137 {
1138 uint32 i;
1139
1140 if (a[0] != v0)
1141 return (a[0] & FPN_FRSIGN)? -1: +1;
1142 for (i = 1; i < cnt; i++) {
1143 if (a[i] != 0)
1144 return (a[0] & FPN_FRSIGN)? -1: +1;
1145 }
1146 return 0;
1147 }
1148
1149 /* Fraction compare - 24b or 60b */
1150
1151 int32 fpp_fr_cmp (uint32 *a, uint32 *b, uint32 cnt)
1152 {
1153 uint32 i;
1154
1155 if ((a[0] ^ b[0]) & FPN_FRSIGN)
1156 return (b[0] & FPN_FRSIGN)? +1: -1;
1157 for (i = 0; i < cnt; i++) {
1158 if (a[i] > b[i])
1159 return (b[0] & FPN_FRSIGN)? +1: -1;
1160 if (a[i] < b[i])
1161 return (b[0] & FPN_FRSIGN)? -1: +1;
1162 }
1163 return 0;
1164 }
1165
1166 /* Fraction fill */
1167
1168 void fpp_fr_fill (uint32 *a, uint32 v, uint32 cnt)
1169 {
1170 uint32 i;
1171
1172 for (i = 0; i < cnt; i++)
1173 a[i] = v;
1174 return;
1175 }
1176
1177 /* Left shift n (unsigned) */
1178
1179 void fpp_fr_lshn (uint32 *a, uint32 sc, uint32 cnt)
1180 {
1181 uint32 i;
1182
1183 if (sc >= (cnt * 12)) { /* out of range? */
1184 fpp_fr_fill (a, 0, cnt);
1185 return;
1186 }
1187 while (sc >= 12) { /* word shift? */
1188 fpp_fr_lsh12 (a, cnt);
1189 sc = sc - 12;
1190 }
1191 if (sc == 0) /* any more? */
1192 return;
1193 for (i = 1; i < cnt; i++) /* bit shift */
1194 a[i - 1] = ((a[i - 1] << sc) | (a[i] >> (12 - sc))) & 07777;
1195 a[cnt - 1] = (a[cnt - 1] << sc) & 07777;
1196 return;
1197 }
1198
1199 /* Left shift 12b (unsigned) */
1200
1201 void fpp_fr_lsh12 (uint32 *a, uint32 cnt)
1202 {
1203 uint32 i;
1204
1205 for (i = 1; i < cnt; i++)
1206 a[i - 1] = a[i];
1207 a[cnt - 1] = 0;
1208 return;
1209 }
1210
1211 /* Left shift 1b (unsigned) */
1212
1213 void fpp_fr_lsh1 (uint32 *a, uint32 cnt)
1214 {
1215 uint32 i;
1216
1217 for (i = 1; i < cnt; i++)
1218 a[i - 1] = ((a[i - 1] << 1) | (a[i] >> 11)) & 07777;
1219 a[cnt - 1] = (a[cnt - 1] << 1) & 07777;
1220 return;
1221 }
1222
1223 /* Right shift 1b, with shift in */
1224
1225 void fpp_fr_rsh1 (uint32 *a, uint32 sign, uint32 cnt)
1226 {
1227 uint32 i;
1228
1229 for (i = cnt - 1; i > 0; i--)
1230 a[i] = ((a[i] >> 1) | (a[i - 1] << 11)) & 07777;
1231 a[0] = (a[0] >> 1) | sign;
1232 return;
1233 }
1234
1235 /* Right shift n (signed) */
1236
1237 void fpp_fr_algn (uint32 *a, uint32 sc, uint32 cnt)
1238 {
1239 uint32 i, sign;
1240
1241 sign = (a[0] & FPN_FRSIGN)? 07777: 0;
1242 if (sc >= (cnt * 12)) { /* out of range? */
1243 fpp_fr_fill (a, sign, cnt);
1244 return;
1245 }
1246 while (sc >= 12) {
1247 for (i = cnt - 1; i > 0; i++)
1248 a[i] = a[i - 1];
1249 a[0] = sign;
1250 sc = sc - 12;
1251 }
1252 if (sc == 0)
1253 return;
1254 for (i = cnt - 1; i > 0; i--)
1255 a[i] = ((a[i] >> sc) | (a[i - 1] << (12 - sc))) & 07777;
1256 a[0] = ((a[0] >> sc) | (sign << (12 - sc))) & 07777;
1257 return;
1258 }
1259
1260 /* Read/write routines */
1261
1262 void fpp_read_op (uint32 ea, FPN *a)
1263 {
1264 uint32 i;
1265
1266 fpp_opa = ea;
1267 if (!(fpp_sta & FPS_DP)) {
1268 a->exp = fpp_read (ea++);
1269 a->exp = SEXT12 (a->exp);
1270 }
1271 for (i = 0; i < EXACT; i++)
1272 a->fr[i] = fpp_read (ea + i);
1273 return;
1274 }
1275
1276 void fpp_write_op (uint32 ea, FPN *a)
1277 {
1278 uint32 i;
1279
1280 fpp_opa = ea;
1281 if (!(fpp_sta & FPS_DP))
1282 fpp_write (ea++, a->exp);
1283 for (i = 0; i < EXACT; i++)
1284 fpp_write (ea + i, a->fr[i]);
1285 return;
1286 }
1287
1288 uint32 fpp_read (uint32 ea)
1289 {
1290 ea = ea & ADDRMASK;
1291 if (fpp_cmd & FPC_FIXF)
1292 ea = fpp_aptsvf | (ea & 07777);
1293 return M[ea];
1294 }
1295
1296 void fpp_write (uint32 ea, uint32 val)
1297 {
1298 ea = ea & ADDRMASK;
1299 if (fpp_cmd & FPC_FIXF)
1300 ea = fpp_aptsvf | (ea & 07777);
1301 if (MEM_ADDR_OK (ea))
1302 M[ea] = val & 07777;
1303 return;
1304 }
1305
1306 uint32 apt_read (uint32 ea)
1307 {
1308 ea = ea & ADDRMASK;
1309 return M[ea];
1310 }
1311
1312 void apt_write (uint32 ea, uint32 val)
1313 {
1314 ea = ea & ADDRMASK;
1315 if (MEM_ADDR_OK (ea))
1316 M[ea] = val & 07777;
1317 return;
1318 }
1319
1320 /* Utility routines */
1321
1322 void fpp_load_apt (uint32 ad)
1323 {
1324 uint32 wd0, i;
1325
1326 wd0 = apt_read (ad++);
1327 fpp_fpc = ((wd0 & 07) << 12) | apt_read (ad++);
1328 if (FPC_GETFAST (fpp_cmd) != 017) {
1329 fpp_xra = ((wd0 & 00070) << 9) | apt_read (ad++);
1330 fpp_bra = ((wd0 & 00700) << 6) | apt_read (ad++);
1331 ad++;
1332 fpp_ac.exp = apt_read (ad++);
1333 for (i = 0; i < EXACT; i++)
1334 fpp_ac.fr[i] = apt_read (ad++);
1335 }
1336 fpp_aptsvf = (ad - 1) & 070000;
1337 fpp_sta |= FPS_RUN;
1338 return;
1339 }
1340
1341 void fpp_dump_apt (uint32 ad, uint32 sta)
1342 {
1343 uint32 wd0, i;
1344
1345 wd0 = (fpp_fpc >> 12) & 07;
1346 if (FPC_GETFAST (fpp_cmd) != 017)
1347 wd0 = wd0 |
1348 ((fpp_opa >> 3) & 07000) |
1349 ((fpp_bra >> 6) & 00700) |
1350 ((fpp_xra >> 9) & 00070);
1351 apt_write (ad++, wd0);
1352 apt_write (ad++, fpp_fpc);
1353 if (FPC_GETFAST (fpp_cmd) != 017) {
1354 apt_write (ad++, fpp_xra);
1355 apt_write (ad++, fpp_bra);
1356 apt_write (ad++, fpp_opa);
1357 apt_write (ad++, fpp_ac.exp);
1358 for (i = 0; i < EXACT; i++)
1359 apt_write (ad++, fpp_ac.fr[i]);
1360 }
1361 fpp_sta = (fpp_sta | sta) & ~FPS_RUN;
1362 fpp_flag = 1;
1363 if (fpp_cmd & FPC_IE)
1364 int_req |= INT_FPP;
1365 return;
1366 }
1367
1368 /* Reset routine */
1369
1370 t_stat fpp_reset (DEVICE *dptr)
1371 {
1372 sim_cancel (&fpp_unit);
1373 fpp_sta = 0;
1374 fpp_cmd = 0;
1375 fpp_flag = 0;
1376 int_req &= ~INT_FPP;
1377 if (sim_switches & SWMASK ('P')) {
1378 fpp_apta = 0;
1379 fpp_aptsvf = 0;
1380 fpp_fpc = 0;
1381 fpp_bra = 0;
1382 fpp_xra = 0;
1383 fpp_opa = 0;
1384 fpp_ac = fpp_zero;
1385 }
1386 return SCPE_OK;
1387 }