| /* sigma_cis.c: Sigma decimal instructions | |
| Copyright (c) 2007-2018, Robert M Supnik | |
| Permission is hereby granted, free of charge, to any person obtaining a | |
| copy of this software and associated documentation files (the "Software"), | |
| to deal in the Software without restriction, including without limitation | |
| the rights to use, copy, modify, merge, publish, distribute, sublicense, | |
| and/or sell copies of the Software, and to permit persons to whom the | |
| Software is furnished to do so, subject to the following conditions: | |
| The above copyright notice and this permission notice shall be included in | |
| all copies or substantial portions of the Software. | |
| THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR | |
| IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | |
| FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL | |
| ROBERT M SUPNIK BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER | |
| IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN | |
| CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. | |
| Except as contained in this notice, the name of Robert M Supnik shall not be | |
| used in advertising or otherwise to promote the sale, use or other dealings | |
| in this Software without prior written authorization from Robert M Supnik. | |
| Questions: | |
| 1. On the Sigma 9, in ASCII mode, is an ASCII blank used in EBS? | |
| 02-Jun-2018 RMS Fixed unsigned < 0 in decimal compare (Mark Pizzolato) | |
| */ | |
| #include "sigma_defs.h" | |
| /* Decimal string structure */ | |
| #define DSTRLNT 4 /* words per dec string */ | |
| #define DECA 12 /* first dec accum reg */ | |
| /* Standard characters */ | |
| #define ZONE_E 0xF0 /* EBCDIC zone bits */ | |
| #define ZONE_A 0x30 /* ASCII zone bits */ | |
| #define ZONE ((PSW1 & PSW1_AS)? ZONE_A: ZONE_E) | |
| #define PKPLUS_E 0xC /* EBCDIC preferred plus */ | |
| #define PKPLUS_A 0xA /* ASCII preferred plus */ | |
| #define PKPLUS ((PSW1 & PSW1_AS)? PKPLUS_A: PKPLUS_E) | |
| #define BLANK_E 0x40 /* EBCDIC blank */ | |
| #define BLANK_A 0x20 /* ASCII blank */ | |
| #define BLANK ((PSW1 & PSW1_AS)? BLANK_A: BLANK_E) | |
| /* Edit special characters */ | |
| #define ED_DS 0x20 /* digit select */ | |
| #define ED_SS 0x21 /* start significance */ | |
| #define ED_FS 0x22 /* field separator */ | |
| #define ED_SI 0x23 /* immediate significance */ | |
| /* Decimal strings run low order (word 0/R15) to high order (word 3/R12) */ | |
| typedef struct { | |
| uint32 sign; | |
| uint32 val[DSTRLNT]; | |
| } dstr_t; | |
| /* Copy decimal accumulator to decimal string, no validation or sign separation */ | |
| #define ReadDecA(src) for (i = 0; i < DSTRLNT; i++) \ | |
| src.val[DSTRLNT - 1 - i] = R[DECA + i]; | |
| static dstr_t Dstr_zero = { 0, 0, 0, 0, 0 }; | |
| extern uint32 *R; | |
| extern uint32 CC; | |
| extern uint32 PSW1; | |
| extern uint32 bvamqrx; | |
| extern uint32 cpu_model; | |
| uint32 ReadDstr (uint32 lnt, uint32 addr, dstr_t *dec); | |
| uint32 WriteDstr (uint32 lnt, uint32 addr, dstr_t *dec); | |
| void WriteDecA (dstr_t *dec, t_bool cln); | |
| void SetCC2Dstr (uint32 lnt, dstr_t *dst); | |
| uint32 TestDstrValid (dstr_t *src); | |
| uint32 DstrInvd (void); | |
| uint32 AddDstr (dstr_t *src1, dstr_t *src2, dstr_t *dst, uint32 cin); | |
| void SubDstr (dstr_t *src1, dstr_t *src2, dstr_t *dst); | |
| int32 CmpDstr (dstr_t *src1, dstr_t *src2); | |
| uint32 LntDstr (dstr_t *dsrc); | |
| uint32 NibbleLshift (dstr_t *dsrc, uint32 sc, uint32 cin); | |
| uint32 NibbleRshift (dstr_t *dsrc, uint32 sc, uint32 cin); | |
| t_bool GenLshift (dstr_t *dsrc, uint32 sc); | |
| void GenRshift (dstr_t *dsrc, uint32 sc); | |
| uint32 ed_getsrc (uint32 sa, uint32 *c, uint32 *d); | |
| void ed_advsrc (uint32 rn, uint32 c); | |
| t_bool cis_test_int (dstr_t *src1, uint32 *kint); | |
| void cis_dm_int (dstr_t *src, dstr_t *dst, uint32 kint); | |
| void cis_dd_int (dstr_t *src, dstr_t *dst, uint32 t, uint32 *kint); | |
| /* Decimal instructions */ | |
| uint32 cis_dec (uint32 op, uint32 lnt, uint32 bva) | |
| { | |
| dstr_t src1, src2, src2x, dst; | |
| uint32 i, t, kint, ldivr, ldivd, ad, c, d, end; | |
| int32 sc, scmp; | |
| uint32 tr; | |
| if (lnt == 0) /* adjust length */ | |
| lnt = 16; | |
| CC &= ~(CC1|CC2); /* clear CC1, CC2 */ | |
| switch (op) { /* case on opcode */ | |
| case OP_DL: /* decimal load */ | |
| if ((tr = ReadDstr (lnt, bva, &dst)) != 0) /* read mem string */ | |
| return tr; | |
| WriteDecA (&dst, FALSE); /* store result */ | |
| break; | |
| case OP_DST: /* decimal store */ | |
| ReadDecA (dst); /* read dec accum */ | |
| if ((tr = TestDstrValid (&dst)) != 0) /* valid? */ | |
| return tr; | |
| if ((tr = WriteDstr (lnt, bva, &dst)) != 0) /* write to mem */ | |
| return tr; | |
| break; | |
| case OP_DS: /* decimal subtract */ | |
| case OP_DA: /* decimal add */ | |
| ReadDecA (src1); /* read dec accum */ | |
| if ((tr = TestDstrValid (&src1)) != 0) /* valid? */ | |
| return tr; | |
| if ((tr = ReadDstr (lnt, bva, &src2)) != 0) /* read mem string */ | |
| return tr; | |
| if (op == OP_DS) /* sub? invert sign */ | |
| src2.sign = src2.sign ^ 1; | |
| if (src1.sign ^ src2.sign) { /* opp signs? sub */ | |
| if (CmpDstr (&src1, &src2) < 0) { /* src1 < src2? */ | |
| SubDstr (&src1, &src2, &dst); /* src2 - src1 */ | |
| dst.sign = src2.sign; /* sign = src2 */ | |
| } | |
| else { | |
| SubDstr (&src2, &src1, &dst); /* src1 - src2 */ | |
| dst.sign = src1.sign; /* sign = src1 */ | |
| } | |
| } | |
| else { /* addition */ | |
| if (AddDstr (&src1, &src2, &dst, 0)) { /* add, overflow? */ | |
| CC |= CC2; /* set CC2 */ | |
| return (PSW1 & PSW1_DM)? TR_DEC: 0; /* trap if enabled */ | |
| } | |
| dst.sign = src1.sign; /* set result sign */ | |
| } | |
| WriteDecA (&dst, TRUE); /* store result */ | |
| break; | |
| case OP_DC: /* decimal compare */ | |
| ReadDecA ( src1); /* read dec accum */ | |
| if ((tr = TestDstrValid (&src1)) != 0) /* valid? */ | |
| return tr; | |
| if ((tr = ReadDstr (lnt, bva, &src2)) != 0) /* read mem string */ | |
| return tr; | |
| LntDstr (&src1); /* clean -0 */ | |
| LntDstr (&src2); | |
| if (src1.sign ^ src2.sign) /* signs differ? */ | |
| CC = src1.sign? CC4: CC3; /* set < or > */ | |
| else { /* same signs */ | |
| scmp = CmpDstr (&src1, &src2); /* compare strings */ | |
| if (scmp < 0) | |
| CC = (src1.sign? CC3: CC4); | |
| else if (scmp > 0) | |
| CC = (src1.sign? CC4: CC3); | |
| else CC = 0; | |
| } | |
| break; | |
| /* Decimal multiply - algorithm from George Plue. | |
| The Sigma does decimal multiply one digit at a time, using the multiplicand | |
| and a doubled copy of the multiplicand. Multiplying by digits 1-5 is | |
| synthesized by 1-3 adds; multiplying by digits 6-9 is synthesized by 1-2 | |
| subtractions, and adding 1 to the next multiplier digit. (That is, | |
| multiplying by 7 is done by multiplying by "10 - 3".) This requires at | |
| most one extra add to fixup the last digit, and minimizes the overall | |
| number of adds (average 1.5 adds per multiplier digit). Note that | |
| multiplication proceeds from right to left. | |
| The Sigma 5-9 allowed decimal multiply to be interrupted; the 5X0 series | |
| did not. An interrupted multiply uses a sign digit in R12 and R13 as the | |
| divider between the remaining multiplier (to the left of the sign, and | |
| in the low-order digit of R15) and the partial product (to the right of | |
| the sign). Because the partial product may be negative, leading 0x99's | |
| may have been stripped and need to be restored. | |
| The real Sigma's probably didn't run a validty test after separation of | |
| the partial product and multiplier, but it doesn't hurt, and prevents | |
| certain corner cases from causing errors. */ | |
| case OP_DM: /* decimal multiply */ | |
| if (lnt >= 9) /* invalid length? */ | |
| return DstrInvd (); | |
| ReadDecA (src1); /* get dec accum */ | |
| if ((tr = ReadDstr (lnt, bva, &src2)) != 0) /* read mem string */ | |
| return tr; | |
| dst = Dstr_zero; /* clear result */ | |
| kint = 0; /* assume no int */ | |
| if (!QCPU_5X0 && /* S5-9? */ | |
| (cis_test_int (&src1, &kint))) { /* interrupted? */ | |
| src1.sign = 0; | |
| cis_dm_int (&src1, &dst, kint); /* restore */ | |
| } | |
| else if ((tr = TestDstrValid (&src1)) != 0) /* mpyr valid? */ | |
| return tr; | |
| if (LntDstr (&src1) && LntDstr (&src2)) { /* both opnds != 0? */ | |
| dst.sign = src1.sign ^ src2.sign; /* sign of result */ | |
| AddDstr (&src2, &src2, &src2x, 0); /* get 2*mplcnd */ | |
| for (i = 1; i <= 16; i++) { /* 16 iterations */ | |
| if (i >= kint) { /* past int point? */ | |
| NibbleRshift (&src1, 1, 0); /* mpyr right 4 */ | |
| d = src1.val[0] & 0xF; /* get digit */ | |
| switch (d) { /* case */ | |
| case 5: /* + 2 + 2 + 1 */ | |
| AddDstr (&src2x, &dst, &dst, 0); | |
| case 3: /* + 2 + 1 */ | |
| AddDstr (&src2x, &dst, &dst, 0); | |
| case 1: /* + 1 */ | |
| AddDstr (&src2, &dst, &dst, 0); | |
| case 0: | |
| break; | |
| case 4: /* + 2 + 2 */ | |
| AddDstr (&src2x, &dst, &dst, 0); | |
| case 2: /* + 2 */ | |
| AddDstr (&src2x, &dst, &dst, 0); | |
| break; | |
| case 6: /* - 2 - 2 + 10 */ | |
| SubDstr (&src2x, &dst, &dst); | |
| case 8: /* - 2 + 10 */ | |
| SubDstr (&src2x, &dst, &dst); | |
| src1.val[0] += 0x10; /* + 10 */ | |
| break; | |
| case 7: /* -2 - 1 + 10 */ | |
| SubDstr (&src2x, &dst, &dst); | |
| case 9: /* -1 + 10 */ | |
| SubDstr (&src2, &dst, &dst); | |
| default: /* + 10 */ | |
| src1.val[0] += 0x10; | |
| } /* end switch */ | |
| } /* end if >= kint */ | |
| NibbleLshift (&src2, 1, 0); /* shift mplcnds */ | |
| NibbleLshift (&src2x, 1, 0); | |
| } /* end for */ | |
| } /* end if != 0 */ | |
| WriteDecA (&dst, TRUE); /* store result */ | |
| break; | |
| /* Decimal divide overflow calculation - if the dividend has true length d, | |
| and the divisor true length r, then the quotient will have (d - r) or | |
| (d - r + 1) digits. Therefore, if (d - r) > 15, the quotient will not | |
| fit. However, if (d - r) == 15, it may or may not fit, depending on | |
| whether the first subtract succeeds. Therefore, it's necessary to test | |
| after the divide to see if the quotient has one extra digit. */ | |
| case OP_DD: /* decimal divide */ | |
| if (lnt >= 9) /* invalid length? */ | |
| return DstrInvd (); | |
| ReadDecA (src1); /* read dec accum */ | |
| if ((tr = ReadDstr (lnt, bva, &src2)) != 0) /* read mem string */ | |
| return tr; | |
| dst = Dstr_zero; /* clear result */ | |
| kint = 0; /* no interrupt */ | |
| if (!QCPU_5X0 && /* S5-9? */ | |
| (cis_test_int (&src1, &t))) { /* interrupted? */ | |
| src1.sign = 0; | |
| cis_dd_int (&src1, &dst, t, &kint); /* restore */ | |
| t = t - 1; | |
| } | |
| else { /* normal start? */ | |
| if ((tr = TestDstrValid (&src1)) != 0) /* divd valid? */ | |
| return tr; | |
| ldivr = LntDstr (&src2); /* divr lnt */ | |
| ldivd = LntDstr (&src1); /* divd lnt */ | |
| if ((ldivr == 0) || /* div by zero? */ | |
| (ldivd > (ldivr + 15))) { /* quo too big? */ | |
| CC |= CC2; /* divide check */ | |
| return (PSW1 & PSW1_DM)? TR_DEC: 0; /* trap if enabled */ | |
| } | |
| if (CmpDstr (&src1, &src2) < 0) { /* no divide? */ | |
| R[12] = src1.val[1]; /* remainder */ | |
| R[13] = src1.val[0] | (PKPLUS + src1.sign); | |
| R[14] = 0; /* quotient */ | |
| R[15] = PKPLUS; | |
| CC = 0; | |
| return SCPE_OK; | |
| } | |
| t = ldivd - ldivr; | |
| } | |
| dst.sign = src1.sign ^ src2.sign; /* calculate sign */ | |
| GenLshift (&src2, t); /* align */ | |
| for (i = 0; i <= t; i++) { /* divide loop */ | |
| for (d = kint; /* find digit */ | |
| (d < 10) && (CmpDstr (&src1, &src2) >= 0); | |
| d++) | |
| SubDstr (&src2, &src1, &src1); | |
| dst.val[0] = (dst.val[0] & ~0xF) | d; /* insert quo dig */ | |
| NibbleLshift (&dst, 1, 0); /* shift quotient */ | |
| NibbleRshift (&src2, 1, 0); /* shift divisor */ | |
| kint = 0; /* no more int */ | |
| } /* end divide loop */ | |
| if (dst.val[2]) { /* quotient too big? */ | |
| CC |= CC2; /* divide check */ | |
| return (PSW1 & PSW1_DM)? TR_DEC: 0; /* trap if enabled */ | |
| } | |
| CC = dst.sign? CC4: CC3; /* set CC's */ | |
| R[12] = src1.val[1]; /* remainder */ | |
| R[13] = src1.val[0] | (PKPLUS + src1.sign); | |
| R[14] = dst.val[1]; /* quotient */ | |
| R[15] = dst.val[0] | (PKPLUS + dst.sign); | |
| break; | |
| case OP_DSA: /* decimal shift */ | |
| ReadDecA (dst); /* read dec accum */ | |
| if ((tr = TestDstrValid (&dst)) != 0) /* valid? */ | |
| return tr; | |
| CC = 0; /* clear CC's */ | |
| sc = SEXT_H_W (bva >> 2); /* shift count */ | |
| if (sc > 31) /* sc in [-31,31] */ | |
| sc = 31; | |
| if (sc < -31) | |
| sc = -31; | |
| if (sc < 0) { /* right shift? */ | |
| sc = -sc; /* |shift| */ | |
| GenRshift (&dst, sc); /* do shift */ | |
| dst.val[0] = dst.val[0] & ~0xF; /* clear sign */ | |
| } /* end right shift */ | |
| else if (sc) { /* left shift? */ | |
| if (GenLshift (&dst, sc)) /* do shift */ | |
| CC |= CC2; | |
| } /* end left shift */ | |
| WriteDecA (&dst, FALSE); /* store result */ | |
| break; | |
| case OP_PACK: /* zoned to packed */ | |
| dst = Dstr_zero; /* clear result */ | |
| end = (2 * lnt) - 1; /* zoned length */ | |
| for (i = 1; i <= end; i++) { /* loop thru char */ | |
| ad = (bva + end - i) & bvamqrx; /* zoned character */ | |
| if ((tr = ReadB (ad, &c, VR)) != 0) /* read char */ | |
| return tr; | |
| if (i == 1) { /* sign + digit? */ | |
| uint32 s; | |
| s = (c >> 4) & 0xF; /* get sign */ | |
| if (s < 0xA) | |
| return DstrInvd (); | |
| if ((s == 0xB) || (s == 0xD)) /* negative */ | |
| dst.sign = 1; | |
| } | |
| d = c & 0xF; /* get digit */ | |
| if (d > 0x9) | |
| return DstrInvd (); | |
| dst.val[i / 8] = dst.val[i / 8] | (d << ((i % 8) * 4)); | |
| } | |
| WriteDecA (&dst, FALSE); /* write result */ | |
| break; | |
| case OP_UNPK: /* packed to zoned */ | |
| ReadDecA (dst); /* read dec accum */ | |
| if ((tr = TestDstrValid (&dst)) != 0) /* valid? */ | |
| return tr; | |
| end = (2 * lnt) - 1; /* zoned length */ | |
| if ((tr = ReadB (bva, &c, VW)) != 0) /* prove writeable */ | |
| return tr; | |
| for (i = 1; i <= end; i++) { /* loop thru chars */ | |
| c = (dst.val[i / 8] >> ((i % 8) * 4)) & 0xF; /* get digit */ | |
| if (i == 1) /* first? */ | |
| c |= ((PKPLUS + dst.sign) << 4); /* or in sign */ | |
| else c |= ZONE; /* no, or in zone */ | |
| ad = (bva + end - i) & bvamqrx; | |
| if ((tr = WriteB (ad, c, VW)) != 0) /* write to memory */ | |
| return tr; | |
| } | |
| SetCC2Dstr (lnt, &dst); /* see if too long */ | |
| break; | |
| } | |
| return 0; | |
| } | |
| /* Test for interrupted multiply or divide */ | |
| t_bool cis_test_int (dstr_t *src, uint32 *kint) | |
| { | |
| int32 i; | |
| uint32 wd, sc, d; | |
| for (i = 15; i >= 1; i--) { /* test 15 nibbles */ | |
| wd = (DSTRLNT/2) + (i / 8); | |
| sc = (i % 8) * 4; | |
| d = (src->val[wd] >> sc) & 0xF; | |
| if (d >= 0xA) { | |
| *kint = (uint32) i; | |
| return TRUE; | |
| } | |
| } | |
| return FALSE; | |
| } | |
| /* Resume interrupted multiply | |
| The sign that was found is the "fence" between the the remaining multiplier | |
| and the partial product: | |
| R val | |
| +--+--+--+--+--+--+--+--+ | |
| | mpyer |sn|pp| 12 3 | |
| +--+--+--+--+--+--+--+--+ | |
| | partial product | 13 2 | |
| +--+--+--+--+--+--+--+--+ | |
| | partial product | 14 1 | |
| +--+--+--+--+--+--+--+--+ | |
| | partial product |mp| 15 0 | |
| +--+--+--+--+--+--+--+--+ | |
| This routine separates the multiplier and partial product, returns the | |
| multiplier as a valid decimal string in src, and the partial product | |
| as a value with no sign in dst */ | |
| void cis_dm_int (dstr_t *src, dstr_t *dst, uint32 kint) | |
| { | |
| uint32 ppneg, wd, sc, d, curd; | |
| int32 k; | |
| *dst = *src; /* copy input */ | |
| wd = (DSTRLNT/2) + (kint / 8); | |
| sc = (kint % 8) * 4; | |
| d = (src->val[wd] >> sc) & 0xF; /* get sign fence */ | |
| ppneg = ((d >> 2) & 1) ^ 1; /* partial prod neg? */ | |
| curd = (src->val[0] & 0xF) + ppneg; /* bias cur digit */ | |
| src->val[wd] = (src->val[wd] & ~(0xF << sc)) | /* replace sign */ | |
| (curd << sc); /* with digit */ | |
| GenRshift (src, kint + 15); /* right justify */ | |
| src->sign = ((d == 0xB) || (d == 0xD))? 1: 0; /* set mpyr sign */ | |
| src->val[0] = src->val[0] & ~0xF; /* clear sign pos */ | |
| /* Mask out multiplier */ | |
| for (k = DSTRLNT - 1; k >= (int32) wd; k--) /* words hi to lo */ | |
| dst->val[k] &= ~(0xFFFFFFFFu << | |
| ((k > (int32) wd)? 0: sc)); | |
| /* Recreate missing high order digits for negative partial product */ | |
| if (ppneg) { /* negative? */ | |
| for (k = (DSTRLNT * 4) - 1; k != 0; k--) { /* bytes hi to lo */ | |
| wd = k / 4; | |
| sc = (k % 4) * 8; | |
| if (((dst->val[wd] >> sc) & 0xFF) != 0) | |
| break; | |
| dst->val[wd] |= (0x99 << sc); /* repl 00 with 99 */ | |
| } /* end for */ | |
| } | |
| dst->val[0] &= ~0xF; /* clear pp sign */ | |
| return; | |
| } | |
| /* Resume interrupted divide | |
| The sign that was found is the "fence" between the the quotient and the | |
| remaining dividend product: | |
| R val | |
| +--+--+--+--+--+--+--+--+ | |
| | quotient |sn|dv| 12 3 | |
| +--+--+--+--+--+--+--+--+ | |
| | dividend | 13 2 | |
| +--+--+--+--+--+--+--+--+ | |
| | dividend | 14 1 | |
| +--+--+--+--+--+--+--+--+ | |
| | dividend |qu| 15 0 | |
| +--+--+--+--+--+--+--+--+ | |
| This routine separates the quotient and the remaining dividend, returns | |
| the dividend as a valid decimal string, the quotient as a decimal string | |
| without sign, and kint is the partial value of the last quotient digit. */ | |
| void cis_dd_int (dstr_t *src, dstr_t *dst, uint32 nib, uint32 *kint) | |
| { | |
| uint32 wd, sc, d, curd; | |
| int32 k; | |
| wd = (DSTRLNT/2) + (nib / 8); | |
| sc = (nib % 8) * 4; | |
| curd = src->val[0] & 0xF; /* last quo digit */ | |
| *dst = *src; /* copy input */ | |
| GenRshift (dst, nib + 16); /* right justify quo */ | |
| d = dst->val[0] & 0xF; /* get sign fence */ | |
| dst->val[0] = (dst->val[0] & ~0xF) | curd; /* repl with digit */ | |
| *kint = curd; | |
| /* Mask out quotient */ | |
| for (k = DSTRLNT - 1; k >= (int32) wd; k--) /* words hi to lo */ | |
| src->val[k] &= ~(0xFFFFFFFFu << | |
| ((k > (int32) wd)? 0: sc)); | |
| src->sign = ((d == 0xB) || (d == 0xD))? 1: 0; /* set divd sign */ | |
| src->val[0] = src->val[0] & ~0xF; /* clr sign digit */ | |
| return; | |
| } | |
| /* Get packed decimal string from memory | |
| Arguments: | |
| lnt = decimal string length | |
| adr = decimal string address | |
| src = decimal string structure | |
| Output: | |
| trap or abort signal | |
| Per the Sigma spec, bad digits or signs cause a fault or abort */ | |
| uint32 ReadDstr (uint32 lnt, uint32 adr, dstr_t *src) | |
| { | |
| uint32 i, c, bva; | |
| uint32 tr; | |
| *src = Dstr_zero; /* clear result */ | |
| for (i = 0; i < lnt; i++) { /* loop thru string */ | |
| bva = (adr + lnt - i - 1) & bvamqrx; /* from low to high */ | |
| if ((tr = ReadB (bva, &c, VR)) != 0) /* read byte */ | |
| return tr; | |
| src->val[i / 4] = src->val[i / 4] | (c << ((i % 4) * 8)); | |
| } /* end for */ | |
| return TestDstrValid (src); | |
| } | |
| /* Separate sign, validate sign and digits of decimal string */ | |
| uint32 TestDstrValid (dstr_t *src) | |
| { | |
| uint32 i, j, s, t; | |
| s = src->val[0] & 0xF; /* get sign */ | |
| if (s < 0xA) /* valid? */ | |
| return DstrInvd (); | |
| if ((s == 0xB) || (s == 0xD)) /* negative? */ | |
| src->sign = 1; | |
| else src->sign = 0; | |
| src->val[0] &= ~0xF; /* clear sign */ | |
| for (i = 0; i < DSTRLNT; i++) { /* check 4 words */ | |
| for (j = 0; j < 8; j++) { /* 8 digit/word */ | |
| t = (src->val[i] >> (28 - (j * 4))) & 0xF; /* get digit */ | |
| if (t > 0x9) /* invalid digit? */ | |
| return DstrInvd (); /* exception */ | |
| } | |
| } | |
| return 0; | |
| } | |
| /* Invalid digit or sign: set CC1, trap or abort instruction */ | |
| uint32 DstrInvd (void) | |
| { | |
| CC |= CC1; /* set CC1 */ | |
| if (PSW1 & PSW1_DM) /* if enabled, trap */ | |
| return TR_DEC; | |
| return WSIGN; /* otherwise, abort */ | |
| } | |
| /* Store decimal string | |
| Arguments: | |
| lnt = decimal string length | |
| adr = decimal string address | |
| dst = decimal string structure | |
| Returns memory management traps (if any) | |
| Bad digits and invalid sign are impossible | |
| */ | |
| uint32 WriteDstr (uint32 lnt, uint32 adr, dstr_t *dst) | |
| { | |
| uint32 i, bva, c; | |
| uint32 tr; | |
| dst->val[0] = dst->val[0] | (PKPLUS + dst->sign); /* set sign */ | |
| if ((tr = ReadB (adr, &c, VW)) != 0) /* prove writeable */ | |
| return tr; | |
| for (i = 0; i < lnt; i++) { /* loop thru bytes */ | |
| c = (dst->val[i / 4] >> ((i % 4) * 8)) & 0xFF; /* from low to high */ | |
| bva = (adr + lnt - i - 1) & bvamqrx; | |
| if ((tr = WriteB (bva, c, VW)) != 0) /* store byte */ | |
| return tr; | |
| } /* end for */ | |
| SetCC2Dstr (lnt, dst); /* check overflow */ | |
| return 0; | |
| } | |
| /* Store result in decimal accumulator | |
| Arguments: | |
| dst = decimal string structure | |
| cln = clean -0 if true | |
| Sets condition codes CC3 and CC4 | |
| Bad digits and invalid sign are impossible */ | |
| void WriteDecA (dstr_t *dst, t_bool cln) | |
| { | |
| uint32 i, nz; | |
| CC &= ~(CC3|CC4); /* assume zero */ | |
| for (i = 0, nz = 0; i < DSTRLNT; i++) { /* save 32 digits */ | |
| R[DECA + i] = dst->val[DSTRLNT - 1 - i]; | |
| nz |= dst->val[DSTRLNT - 1 - i]; | |
| } | |
| if (nz) /* non-zero? */ | |
| CC |= (dst->sign)? CC4: CC3; /* set CC3 or CC4 */ | |
| else if (cln) /* zero, clean? */ | |
| dst->sign = 0; /* clear sign */ | |
| R[DECA + DSTRLNT - 1] |= (PKPLUS + dst->sign); /* or in sign */ | |
| return; | |
| } | |
| /* Set CC2 for decimal string store | |
| Arguments: | |
| lnt = string length | |
| dst = decimal string structure | |
| Output: | |
| sets CC2 if information won't fit */ | |
| void SetCC2Dstr (uint32 lnt, dstr_t *dst) | |
| { | |
| uint32 i, limit, mask; | |
| static uint32 masktab[8] = { | |
| 0xFFFFFFF0, 0xFFFFFF00, 0xFFFFF000, 0xFFFF0000, | |
| 0xFFF00000, 0xFF000000, 0xF0000000, 0x00000000 | |
| }; | |
| lnt = (lnt * 2) - 1; /* number of digits */ | |
| mask = 0; /* can't ovflo */ | |
| limit = lnt / 8; /* limit for test */ | |
| for (i = 0; i < DSTRLNT; i++) { /* loop thru value */ | |
| if (i == limit) /* @limit, get mask */ | |
| mask = masktab[lnt % 8]; | |
| else if (i > limit) /* >limit, test all */ | |
| mask = 0xFFFFFFFF; | |
| if (dst->val[i] & mask) /* test for ovflo */ | |
| CC |= CC2; | |
| } | |
| return; | |
| } | |
| /* Add decimal string magnitudes | |
| Arguments: | |
| s1 = src1 decimal string | |
| s2 = src2 decimal string | |
| ds = dest decimal string | |
| cy = carry in | |
| Output: | |
| 1 if carry, 0 if no carry | |
| This algorithm courtesy Anton Chernoff, circa 1992 or even earlier. | |
| We trace the history of a pair of adjacent digits to see how the | |
| carry is fixed; each parenthesized item is a 4b digit. | |
| Assume we are adding: | |
| (a)(b) I | |
| + (x)(y) J | |
| First compute I^J: | |
| (a^x)(b^y) TMP | |
| Note that the low bit of each digit is the same as the low bit of | |
| the sum of the digits, ignoring the carry, since the low bit of the | |
| sum is the xor of the bits. | |
| Now compute I+J+66 to get decimal addition with carry forced left | |
| one digit: | |
| (a+x+6+carry mod 16)(b+y+6 mod 16) SUM | |
| Note that if there was a carry from b+y+6, then the low bit of the | |
| left digit is different from the expected low bit from the xor. | |
| If we xor this SUM into TMP, then the low bit of each digit is 1 | |
| if there was a carry, and 0 if not. We need to subtract 6 from each | |
| digit that did not have a carry, so take ~(SUM ^ TMP) & 0x11, shift | |
| it right 4 to the digits that are affected, and subtract 6*adjustment | |
| (actually, shift it right 3 and subtract 3*adjustment). | |
| */ | |
| uint32 AddDstr (dstr_t *s1, dstr_t *s2, dstr_t *ds, uint32 cy) | |
| { | |
| uint32 i; | |
| uint32 sm1, sm2, tm1, tm2, tm3, tm4; | |
| for (i = 0; i < DSTRLNT; i++) { /* loop low to high */ | |
| tm1 = s1->val[i] ^ (s2->val[i] + cy); /* xor operands */ | |
| sm1 = s1->val[i] + (s2->val[i] + cy); /* sum operands */ | |
| sm2 = sm1 + 0x66666666; /* force carry out */ | |
| cy = ((sm1 < s1->val[i]) || (sm2 < sm1)); /* check for ovflo */ | |
| tm2 = tm1 ^ sm2; /* get carry flags */ | |
| tm3 = (tm2 >> 3) | (cy << 29); /* compute adjust */ | |
| tm4 = 0x22222222 & ~tm3; /* clrr where carry */ | |
| ds->val[i] = (sm2 - (3 * tm4)) & WMASK; /* final result */ | |
| } | |
| return cy; | |
| } | |
| /* Subtract decimal string magnitudes | |
| Arguments: | |
| s1 = src1 decimal string | |
| s2 = src2 decimal string | |
| ds = dest decimal string | |
| Note: the routine assumes that s1 <= s2 | |
| */ | |
| void SubDstr (dstr_t *s1, dstr_t *s2, dstr_t *ds) | |
| { | |
| uint32 i; | |
| dstr_t complm; | |
| for (i = 0; i < DSTRLNT; i++) /* 9's comp s2 */ | |
| complm.val[i] = 0x99999999 - s1->val[i]; | |
| AddDstr (&complm, s2, ds, 1); /* s1 + ~s2 + 1 */ | |
| return; | |
| } | |
| /* Compare decimal string magnitudes | |
| Arguments: | |
| s1 = src1 decimal string | |
| s2 = src2 decimal string | |
| Output: | |
| 1 if >, 0 if =, -1 if < | |
| */ | |
| int32 CmpDstr (dstr_t *s1, dstr_t *s2) | |
| { | |
| int32 i; | |
| for (i = DSTRLNT - 1; i >=0; i--) { | |
| if (s1->val[i] > s2->val[i]) | |
| return 1; | |
| if (s1->val[i] < s2->val[i]) | |
| return -1; | |
| } | |
| return 0; | |
| } | |
| /* Get exact length of decimal string, clean -0 | |
| Arguments: | |
| dst = decimal string structure | |
| Output: | |
| number of non-zero digits | |
| */ | |
| uint32 LntDstr (dstr_t *dst) | |
| { | |
| int32 nz, i; | |
| for (nz = DSTRLNT - 1; nz >= 0; nz--) { | |
| if (dst->val[nz]) { | |
| for (i = 7; i >= 0; i--) { | |
| if ((dst->val[nz] >> (i * 4)) & 0xF) | |
| return (nz * 8) + i; | |
| } | |
| } | |
| } | |
| dst->sign = 0; | |
| return 0; | |
| } | |
| /* Word shift right | |
| Arguments: | |
| dsrc = decimal string structure | |
| sc = shift count in nibbles | |
| */ | |
| void GenRshift (dstr_t *dsrc, uint32 cnt) | |
| { | |
| uint32 i, sc, sc1; | |
| sc = cnt / 8; | |
| sc1 = cnt % 8; | |
| if (sc) { | |
| for (i = 0; i < DSTRLNT; i++) { | |
| if ((i + sc) < DSTRLNT) | |
| dsrc->val[i] = dsrc->val[i + sc]; | |
| else dsrc->val[i] = 0; | |
| } | |
| } | |
| if (sc1) | |
| NibbleRshift (dsrc, sc1, 0); | |
| return; | |
| } | |
| /* General shift left | |
| Arguments: | |
| dsrc = decimal string structure | |
| cnt = shift count in nibbles | |
| */ | |
| t_bool GenLshift (dstr_t *dsrc, uint32 cnt) | |
| { | |
| t_bool i, c, sc, sc1; | |
| c = 0; | |
| sc = cnt / 8; | |
| sc1 = cnt % 8; | |
| if (sc) { | |
| for (i = DSTRLNT - 1; (int32) i >= 0; i--) { | |
| if (i >= sc) | |
| dsrc->val[i] = dsrc->val[i - sc]; | |
| else { | |
| c |= dsrc->val[i]; | |
| dsrc->val[i] = 0; | |
| } | |
| } | |
| } | |
| if (sc1) | |
| c |= NibbleLshift (dsrc, sc1, 0); | |
| return (c? TRUE: FALSE); | |
| } | |
| /* Nibble shift right | |
| Arguments: | |
| dsrc = decimal string structure | |
| sc = shift count in nibbles | |
| cin = carry in | |
| */ | |
| uint32 NibbleRshift (dstr_t *dsrc, uint32 sc, uint32 cin) | |
| { | |
| int32 i; | |
| uint32 s, nc; | |
| if ((s = sc * 4)) { | |
| for (i = DSTRLNT - 1; (int32) i >= 0; i--) { | |
| nc = (dsrc->val[i] << (32 - s)) & WMASK; | |
| dsrc->val[i] = ((dsrc->val[i] >> s) | | |
| cin) & WMASK; | |
| cin = nc; | |
| } | |
| return cin; | |
| } | |
| return 0; | |
| } | |
| /* Nibble shift left | |
| Arguments: | |
| dsrc = decimal string structure | |
| sc = shift count in nibbles | |
| cin = carry in | |
| */ | |
| uint32 NibbleLshift (dstr_t *dsrc, uint32 sc, uint32 cin) | |
| { | |
| uint32 i, s, nc; | |
| if ((s = sc * 4)) { | |
| for (i = 0; i < DSTRLNT; i++) { | |
| nc = dsrc->val[i] >> (32 - s); | |
| dsrc->val[i] = ((dsrc->val[i] << s) | | |
| cin) & WMASK; | |
| cin = nc; | |
| } | |
| return cin; | |
| } | |
| return 0; | |
| } | |
| /* Edit instruction */ | |
| uint32 cis_ebs (uint32 rn, uint32 disp) | |
| { | |
| uint32 sa, da, c, d, dst, fill, pat; | |
| uint32 tr; | |
| disp = SEXT_LIT_W (disp) & WMASK; /* sext operand */ | |
| fill = S_GETMCNT (R[rn]); /* fill char */ | |
| while (S_GETMCNT (R[rn|1])) { /* while pattern */ | |
| sa = (disp + R[rn]) & bvamqrx; /* dec str addr */ | |
| da = R[rn|1] & bvamqrx; /* pattern addr */ | |
| if ((tr = ReadB (da, &pat, VR)) != 0) /* get pattern byte */ | |
| return tr; | |
| switch (pat) { /* case on pattern */ | |
| case ED_DS: /* digit select */ | |
| if ((tr = ed_getsrc (sa, &c, &d)) != 0) /* get src digit */ | |
| return tr; | |
| if (CC & CC4) /* signif? unpack */ | |
| dst = ZONE | d; | |
| else if (d) { /* non-zero? */ | |
| R[1] = da; /* save addr */ | |
| dst = ZONE | d; /* unpack */ | |
| CC |= CC4; /* set signif */ | |
| } | |
| else dst = fill; /* otherwise fill */ | |
| if ((tr = WriteB (da, dst, VW)) != 0) /* overwrite dst */ | |
| return tr; | |
| ed_advsrc (rn, c); /* next src digit */ | |
| break; | |
| case ED_SS: /* signif start */ | |
| if ((tr = ed_getsrc (sa, &c, &d)) != 0) /* get src digit */ | |
| return tr; | |
| if (CC & CC4) /* signif? unpack */ | |
| dst = ZONE | d; | |
| else if (d) { /* non-zero? */ | |
| R[1] = da; /* save addr */ | |
| dst = ZONE | d; /* unpack */ | |
| } | |
| else { /* otherwise */ | |
| R[1] = da + 1; /* save next */ | |
| dst = fill; /* fill */ | |
| } | |
| CC |= CC4; /* set signif */ | |
| if ((tr = WriteB (da, dst, VW)) != 0) /* overwrite dst */ | |
| return tr; | |
| ed_advsrc (rn, c); /* next src digit */ | |
| break; | |
| case ED_SI: /* signif immediate */ | |
| if ((tr = ed_getsrc (sa, &c, &d)) != 0) /* get src digit */ | |
| return tr; | |
| R[1] = da; /* save addr */ | |
| dst = ZONE | d; /* unpack */ | |
| CC |= CC4; /* set signif */ | |
| if ((tr = WriteB (da, dst, VW)) != 0) /* overwrite dst */ | |
| return tr; | |
| ed_advsrc (rn, c); /* next src digit */ | |
| break; | |
| case ED_FS: /* field separator */ | |
| CC &= ~(CC1|CC3|CC4); /* clr all exc CC2 */ | |
| if ((tr = WriteB (da, fill, VW)) != 0) /* overwrite dst */ | |
| return tr; | |
| break; | |
| default: /* all others */ | |
| if ((CC & CC4) == 0) { /* signif off? */ | |
| dst = (CC & CC1)? BLANK: fill; /* blank or fill */ | |
| if ((tr = WriteB (da, dst, VW)) != 0) /* overwrite dst */ | |
| return tr; | |
| } | |
| break; | |
| } /* end switch dst */ | |
| R[rn|1] = (R[rn|1] + S_ADDRINC) & WMASK; /* next pattern */ | |
| } /* end while */ | |
| return 0; | |
| } | |
| /* Routine to get and validate the next source digit */ | |
| uint32 ed_getsrc (uint32 sa, uint32 *c, uint32 *d) | |
| { | |
| uint32 tr; | |
| if ((tr = ReadB (sa, c, VR)) != 0) /* read source byte */ | |
| return tr; | |
| *d = ((CC & CC2)? *c: *c >> 4) & 0xF; /* isolate digit */ | |
| if (*d > 0x9) /* invalid? */ | |
| return TR_DEC; | |
| if (*d) /* non-zero? */ | |
| CC |= CC3; | |
| return 0; | |
| } | |
| /* Routine to advance source string */ | |
| void ed_advsrc (uint32 rn, uint32 c) | |
| { | |
| c = c & 0xF; /* get low digit */ | |
| if (((CC & CC2) == 0) && (c > 0x9)) { /* sel left, with sign? */ | |
| if ((c == 0xB) || (c == 0xD)) /* minus? */ | |
| CC = CC | (CC1|CC4); /* CC1, CC4 */ | |
| else CC = (CC | CC1) & ~CC4; /* no, CC1, ~CC4 */ | |
| R[rn] = R[rn] + 1; /* skip two digits */ | |
| } | |
| else { /* adv 1 digit */ | |
| if (CC & CC2) | |
| R[rn] = R[rn] + 1; | |
| CC = CC ^ CC2; | |
| } | |
| return; | |
| } |