I1620/i1620_fp.c

   1 /* i1620_fp.c: IBM 1620 floating point simulator
   2
   3    Copyright (c) 2002-2008, 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    The IBM 1620 uses a variable length floating point format, with a fixed
  27    two digit decimal exponent and a variable length decimal mantissa:
  28
  29         _       S_S
  30         M.......MEE
  31
  32    where S represents flag bits if the mantissa or exponent are negative.
  33
  34    31-May-2008  RMS     Fixed add_field call (found by Peter Schorn)
  35 */
  36
  37 #include "i1620_defs.h"
  38
  39 #define FP_LMAX         100                             /* max fp mant lnt */
  40 #define FP_EMAX         99                              /* max fp exponent */
  41
  42 /* Unpacked floating point operand */
  43
  44 typedef struct {
  45     int32       sign;                                   /* 0 => +, 1 => - */
  46     int32       exp;                                    /* binary exponent */
  47     uint32      lnt;                                    /* mantissa length */
  48     uint32      addr;                                   /* mantissa addr */
  49     uint32      zero;                                   /* 0 => nz, 1 => zero */
  50     } FPA;
  51
  52 extern uint8 M[MAXMEMSIZE];                             /* main memory */
  53 extern uint8 ind[NUM_IND];                              /* indicators */
  54 extern UNIT cpu_unit;
  55
  56 t_stat fp_scan_mant (uint32 ad, uint32 *lnt, uint32 *zro);
  57 t_stat fp_zero (FPA *fp);
  58
  59 extern t_stat xmt_field (uint32 d, uint32 s, uint32 skp);
  60 extern t_stat add_field (uint32 d, uint32 s, t_bool sub, t_bool sto, uint32 skp, int32 *sta);
  61 extern t_stat mul_field (uint32 d, uint32 s);
  62 extern t_stat xmt_divd (uint32 d, uint32 s);
  63 extern t_stat div_field (uint32 dvd, uint32 dvr, int32 *ez);
  64
  65 /* Unpack and validate a floating point argument */
  66
  67 t_stat fp_unpack (uint32 ad, FPA *fp)
  68 {
  69 uint8 d0, d1, esign;
  70
  71 esign = M[ad] & FLAG;                                   /* get exp sign */
  72 d0 = M[ad] & DIGIT;                                     /* get exp lo digit */
  73 MM (ad);
  74 if ((M[ad] & FLAG) == 0) return STOP_FPMF;              /* no flag on hi exp? */
  75 d1 = M[ad] & DIGIT;                                     /* get exp hi digit */
  76 MM (ad);
  77 fp->addr = ad;                                          /* save mant addr */
  78 if (BAD_DIGIT (d1) || BAD_DIGIT (d0)) return STOP_INVDIG; /* exp bad dig? */
  79 fp->exp = ((d1 * 10) + d0) * (esign? -1: 1);            /* convert exponent */
  80 fp->sign = (M[ad] & FLAG)? 1: 0;                        /* get mantissa sign */
  81 return fp_scan_mant (fp->addr, &(fp->lnt), &(fp->zero));
  82 }
  83
  84 /* Unpack and validate source and destination arguments */
  85
  86 t_stat fp_unpack_two (uint32 dad, uint32 sad, FPA *dfp, FPA *sfp)
  87 {
  88 t_stat r;
  89
  90 if ((r = fp_unpack (dad, dfp)) != SCPE_OK) return r;    /* unpack dst */
  91 if ((r = fp_unpack (sad, sfp)) != SCPE_OK) return r;    /* unpack src */
  92 if (sfp->lnt != dfp->lnt) return STOP_FPUNL;            /* lnts must be equal */
  93 return SCPE_OK;
  94 }
  95
  96 /* Pack floating point result */
  97
  98 t_stat fp_pack (FPA *fp)
  99 {
 100 int32 e;
 101 uint32 i, mad;
 102
 103 e = (fp->exp >= 0)? fp->exp: -fp->exp;                  /* get |exp| */
 104 if (e > FP_EMAX) {                                      /* too big? */
 105     ind[IN_EXPCHK] = 1;                                 /* set indicator */
 106     if (fp->exp < 0) return fp_zero (fp);               /* underflow? */
 107     mad = fp->addr;
 108     for (i = 0; i < fp->lnt; i++) {                     /* mant = 99...99 */
 109         M[mad] = (M[mad] & FLAG) | 9;
 110         MM (mad);
 111         }
 112     e = FP_EMAX;                                        /* cap at max */
 113     }
 114 M[ADDR_A (fp->addr, 1)] = (e / 10) | FLAG;              /* high exp digit */
 115 M[ADDR_A (fp->addr, 2)] = (e % 10) |                    /* low exp digit */
 116      ((fp->exp < 0)? FLAG: 0);
 117 return SCPE_OK;
 118 }
 119
 120 /* Shift mantissa right n positions */
 121
 122 void fp_rsh (FPA *fp, uint32 n)
 123 {
 124 uint32 i, sad, dad;
 125
 126 if (n == 0) return;                                     /* zero? done */
 127 sad = ADDR_S (fp->addr, n);                             /* src = addr - n */
 128 dad = fp->addr;                                         /* dst = n */
 129 for (i = 0; i < fp->lnt; i++) {                         /* move digits */
 130     if (i >= (fp->lnt - n)) M[dad] = M[dad] & FLAG;
 131     else M[dad] = (M[dad] & FLAG) | (M[sad] & DIGIT);
 132     MM (dad);
 133     MM (sad);
 134     }
 135 return;
 136 }
 137
 138 /* Shift mantissa left 1 position */
 139
 140 void fp_lsh_1 (FPA *fp)
 141 {
 142 uint32 i, mad, nxt;
 143
 144 mad = ADDR_S (fp->addr, fp->lnt - 1);                   /* hi order digit */
 145 for (i = 0; i < (fp->lnt - 1); i++) {                   /* move lnt-1 digits */
 146     nxt = ADDR_A (mad, 1);
 147     M[mad] = (M[mad] & FLAG) | (M[nxt] & DIGIT);
 148     mad = nxt;
 149     }
 150 M[mad] = M[mad] & FLAG;                                 /* clear last digit */
 151 return;
 152 }
 153
 154 /* Clear floating point number */
 155
 156 t_stat fp_zero (FPA *fp)
 157 {
 158 uint32 i, mad = fp->addr;
 159
 160 for (i = 0; i < fp->lnt; i++) {                         /* clear mantissa */
 161     M[mad] = (i? M[mad] & FLAG: 0);                     /* clear sign bit */
 162     MM (mad);
 163     }
 164 M[ADDR_A (fp->addr, 1)] = FLAG + 9;                     /* exp = -99 */
 165 M[ADDR_A (fp->addr, 2)] = FLAG + 9;                     /* exp = -99 */
 166 ind[IN_EZ] = 1;                                         /* result = 0 */
 167 ind[IN_HP] = 0;
 168 return SCPE_OK;
 169 }
 170
 171 /* Scan floating point mantissa for length and (optionally) zero */
 172
 173 t_stat fp_scan_mant (uint32 ad, uint32 *lnt, uint32 *zro)
 174 {
 175 uint8 d, l, z;
 176
 177 z = 1;                                                  /* assume zero */
 178 for (l = 1; l <= FP_LMAX; l++) {                        /* scan to get length */
 179     d = M[ad] & DIGIT;                                  /* get mant digit */
 180     if (d) z = 0;                                       /* non-zero? */
 181     if ((l != 1) && (M[ad] & FLAG)) {                   /* flag past first dig? */
 182         *lnt = l;                                       /* set returns */
 183         if (zro) *zro = z;
 184         return SCPE_OK;
 185         }
 186     MM (ad);
 187     }
 188 return STOP_FPLNT;                                      /* too long */
 189 }
 190
 191 /* Copy floating point mantissa */
 192
 193 void fp_copy_mant (uint32 d, uint32 s, uint32 l)
 194 {
 195 uint32 i;
 196
 197 if (ind[IN_HP]) M[d] = M[d] & ~FLAG;                    /* clr/set sign */
 198 else M[d] = M[d] | FLAG;
 199 for (i = 0; i < l; i++) {                               /* copy src */
 200     M[d] = (M[d] & FLAG) | (M[s] & DIGIT);              /* preserve flags */
 201     MM (d);
 202     MM (s);
 203     }
 204 return;
 205 }
 206
 207 /* Compare floating point mantissa */
 208
 209 int32 fp_comp_mant (uint32 d, uint32 s, uint32 l)
 210 {
 211 uint8 i, dd, sd;
 212
 213 d = ADDR_S (d, l - 1);                                  /* start of mantissa */
 214 s = ADDR_S (s, l - 1);
 215 for (i = 0; i < l; i++) {                               /* compare dst:src */
 216     dd = M[d] & DIGIT;                                  /* get dst digit */
 217     sd = M[s] & DIGIT;                                  /* get src digit */
 218     if (dd > sd) return 1;                              /* >? done */
 219     if (dd < sd) return -1;                             /* <? done */
 220     PP (d);                                             /* =? continue */
 221     PP (s);
 222     }
 223 return 0;                                               /* done, equal */
 224 }
 225
 226 /* Floating point add */
 227
 228 t_stat fp_add (uint32 d, uint32 s, t_bool sub)
 229 {
 230 FPA sfp, dfp;
 231 uint32 i, sad, hi;
 232 int32 dif, sta;
 233 uint8 sav_src[FP_LMAX];
 234 t_stat r;
 235
 236 r = fp_unpack_two (d, s, &dfp, &sfp);                   /* unpack operands */
 237 if (r != SCPE_OK) return r;                             /* error? */
 238 dif = dfp.exp - sfp.exp;                                /* exp difference */
 239
 240 if (sfp.zero || (dif >= ((int32) dfp.lnt))) {           /* src = 0, or too small? */
 241     if (dfp.zero) return fp_zero (&dfp);                /* res = dst, zero? */
 242     ind[IN_EZ] = 0;                                     /* res nz, set EZ, HP */
 243     ind[IN_HP] = (dfp.sign == 0);
 244     return SCPE_OK;
 245     }
 246 if (dfp.zero || (dif <= -((int32) dfp.lnt))) {          /* dst = 0, or too small? */
 247     if (sfp.zero) return fp_zero (&dfp);                /* res = src, zero? */
 248     r = xmt_field (d, s, 3);                            /* copy src to dst */
 249     ind[IN_EZ] = 0;                                     /* res nz, set EZ, HP */
 250     ind[IN_HP] = (dfp.sign == 0);
 251     return r;
 252     }
 253
 254 if (dif > 0) {                                          /* dst exp > src exp? */
 255     sad = sfp.addr;                                     /* save src in save area */
 256     for (i = 0; i < sfp.lnt; i++) {
 257         sav_src[i] = M[sad];
 258         MM (sad);
 259         }
 260     fp_rsh (&sfp, dif);                                 /* denormalize src */
 261     }
 262 else if (dif < 0) {                                     /* dst exp < src exp? */
 263     dfp.exp = sfp.exp;                                  /* res exp = src exp */
 264     fp_rsh (&dfp, -dif);                                /* denormalize dst */
 265     }
 266 r = add_field (dfp.addr, sfp.addr, sub, TRUE, 0, &sta); /* add mant, set EZ, HP */
 267 if (dif > 0) {                                          /* src denormalized? */
 268     sad = sfp.addr;                                     /* restore src from */
 269     for (i = 0; i < sfp.lnt; i++) {                     /* save area */
 270         M[sad] = sav_src[i];
 271         MM (sad);
 272         }
 273     }
 274 if (r != SCPE_OK) return r;                             /* add error? */
 275
 276 hi = ADDR_S (dfp.addr, dfp.lnt - 1);                    /* addr of hi digit */
 277 if (sta == ADD_CARRY) {                                 /* carry out? */
 278     fp_rsh (&dfp, 1);                                   /* shift mantissa */
 279     M[hi] = FLAG + 1;                                   /* high order 1 */
 280     dfp.exp = dfp.exp + 1;
 281     ind[IN_EZ] = 0;                                     /* not zero */
 282     ind[IN_HP] = (dfp.sign == 0);                       /* set HP */
 283     }
 284 else if (ind[IN_EZ]) return fp_zero (&dfp);             /* result zero? */
 285 else {
 286     while ((M[hi] & DIGIT) == 0) {                      /* until normalized */
 287         fp_lsh_1 (&dfp);                                /* left shift */
 288         dfp.exp = dfp.exp - 1;                          /* decr exponent */
 289         }
 290     }
 291
 292 return fp_pack (&dfp);                                  /* pack and exit */
 293 }
 294
 295 /* Floating point multiply */
 296
 297 t_stat fp_mul (uint32 d, uint32 s)
 298 {
 299 FPA sfp, dfp;
 300 uint32 pad;
 301 t_stat r;
 302
 303 r = fp_unpack_two (d, s, &dfp, &sfp);                   /* unpack operands */
 304 if (r != SCPE_OK) return r;                             /* error? */
 305 if (sfp.zero || dfp.zero) return fp_zero (&dfp);        /* either zero? */
 306
 307 r = mul_field (dfp.addr, sfp.addr);                     /* mul, set EZ, HP */
 308 if (r != SCPE_OK) return r;
 309 if (M[ADDR_S (PROD_AREA_END, 2 * dfp.lnt)] & DIGIT) {   /* hi prod dig set? */
 310     pad = ADDR_S (PROD_AREA_END - 1, dfp.lnt);          /* no normalization */
 311     dfp.exp = dfp.exp + sfp.exp;                        /* res exp = sum */
 312     }
 313 else {
 314     pad = ADDR_S (PROD_AREA_END, dfp.lnt);              /* 'normalize' 1 */
 315     dfp.exp = dfp.exp + sfp.exp - 1;                    /* res exp = sum - 1 */
 316     }
 317 fp_copy_mant (dfp.addr, pad, dfp.lnt);                  /* copy prod to mant */
 318
 319 return fp_pack (&dfp);                                  /* pack and exit */
 320 }
 321
 322 /* Floating point divide */
 323
 324 t_stat fp_div (uint32 d, uint32 s)
 325 {
 326 FPA sfp, dfp;
 327 uint32 i, pad, a100ml, a99ml;
 328 int32 ez;
 329 t_stat r;
 330
 331 r = fp_unpack_two (d, s, &dfp, &sfp);                   /* unpack operands */
 332 if (r != SCPE_OK) return r;                             /* error? */
 333 if (sfp.zero) {                                         /* divide by zero? */
 334     ind[IN_OVF] = 1;                                    /* dead jim */
 335     return SCPE_OK;
 336     }
 337 if (dfp.zero) return fp_zero (&dfp);                    /* divide into zero? */
 338
 339 for (i = 0; i < PROD_AREA_LEN; i++)                     /* clear prod area */
 340     M[PROD_AREA + i] = 0;
 341 a100ml = ADDR_S (PROD_AREA_END, dfp.lnt);               /* 100 - lnt */
 342 a99ml = ADDR_S (PROD_AREA_END - 1, dfp.lnt);            /* 99 - lnt */
 343 if (fp_comp_mant (dfp.addr, sfp.addr, dfp.lnt) >= 0) {  /* |Mdst| >= |Msrc|? */
 344     pad = a100ml;
 345     dfp.exp = dfp.exp - sfp.exp + 1;                    /* res exp = diff + 1 */
 346     }
 347 else {
 348     pad = a99ml;
 349     dfp.exp = dfp.exp - sfp.exp;                        /* res exp = diff */
 350     }
 351 r = xmt_divd (pad, dfp.addr);                           /* xmt dividend */
 352 if (r != SCPE_OK) return r;                             /* error? */
 353 r = div_field (a100ml, sfp.addr, &ez);                  /* divide fractions */
 354 if (r != SCPE_OK) return r;                             /* error? */
 355 if (ez) return fp_zero (&dfp);                          /* result zero? */
 356
 357 ind[IN_HP] = ((dfp.sign ^ sfp.sign) == 0);              /* set res sign */
 358 ind[IN_EZ] = 0;                                         /* not zero */
 359 fp_copy_mant (dfp.addr, a99ml, dfp.lnt);                /* copy result */
 360
 361 return fp_pack (&dfp);
 362 }
 363
 364 /* Floating shift right */
 365
 366 t_stat fp_fsr (uint32 d, uint32 s)
 367 {
 368 uint32 cnt;
 369 uint8 t;
 370
 371 if (d == s) return SCPE_OK;                             /* no move? */
 372
 373 cnt = 0;
 374 M[d] = (M[d] & FLAG) | (M[s] & DIGIT);                  /* move 1st wo flag */
 375 do {
 376     MM (d);                                             /* decr ptrs */
 377     MM (s);
 378     t = M[d] = M[s] & (FLAG | DIGIT);                   /* copy others */
 379     if (cnt++ > MEMSIZE) return STOP_FWRAP;             /* (stop runaway) */
 380     } while ((t & FLAG) == 0);                          /* until src flag */
 381
 382 cnt = 0;
 383 do {
 384     MM (d);                                             /* decr pointer */
 385     t = M[d];                                           /* save old val */
 386     M[d] = 0;                                           /* zero field */
 387     if (cnt++ > MEMSIZE) return STOP_FWRAP;             /* (stop runaway) */
 388     } while ((t & FLAG) == 0);                          /* until dst flag */
 389 return SCPE_OK;
 390 }
 391
 392 /* Floating shift left - note that dst is addr of high order digit */
 393
 394 t_stat fp_fsl (uint32 d, uint32 s)
 395 {
 396 uint32 i, lnt;
 397 uint8 sign;
 398 t_stat r;
 399
 400 if (d == s) return SCPE_OK;
 401 sign = M[s] & FLAG;                                     /* get src sign */
 402 r = fp_scan_mant (s, &lnt, NULL);                       /* get src length */
 403 if (r != SCPE_OK) return r;                             /* error? */
 404 s = ADDR_S (s, lnt - 1);                                /* hi order src */
 405 M[d] = M[s] & (FLAG | DIGIT);                           /* move 1st w flag */
 406 M[s] = M[s] & ~FLAG;                                    /* clr flag from src */
 407 for (i = 1; i < lnt; i++) {                             /* move src to dst */
 408     PP (d);                                             /* incr ptrs */
 409     PP (s);
 410     M[d] = M[s] & DIGIT;                                /* move just digit */
 411     }
 412 PP (d);                                                 /* incr pointer */
 413 while ((M[d] & FLAG) == 0) {                            /* until flag */
 414     M[d] = 0;                                           /* clear field */
 415     PP (d);
 416     }
 417 if (sign) M[d] = FLAG;                                  /* -? zero under sign */
 418 return SCPE_OK;
 419 }