Return to divbig.c CVS log

Up to [CSRG BSD Unix] / 41BSD / cmd / lisp

Annotation of 41BSD/cmd/lisp/divbig.c, revision 1.1

1.1     ! root        1: 
        !             2: static char *sccsid = "@(#)divbig.c    34.1 10/3/80";
        !             3: 
        !             4: #include "global.h"
        !             5: 
        !             6: #define b 0x40000000
        !             7: #define toint(p) ((int) (p))
        !             8: 
        !             9: divbig(dividend, divisor, quotient, remainder)
        !            10: lispval dividend, divisor, *quotient, *remainder;
        !            11: {
        !            12:        register *ujp, *vip;
        !            13:        int *sp(), *alloca(), d, negflag = 0, m, n, carry, rem, qhat, j;
        !            14:        int borrow, negrem = 0;
        !            15:        int *utop = sp(), *ubot, *vbot, *qbot;
        !            16:        register lispval work; lispval export();
        !            17:        snpand(3);
        !            18: 
        !            19:        /* copy dividend */
        !            20:        for(work = dividend; work; work = work ->s.CDR)
        !            21:                stack(work->s.I);
        !            22:        ubot = sp();
        !            23:        if(*ubot < 0) {         /* knuth's division alg works only for pos
        !            24:                                        bignums                         */
        !            25:                negflag ^= 1;
        !            26:                negrem = 1;
        !            27:                dsmult(utop-1,ubot,-1);
        !            28:        }
        !            29:        stack(0);
        !            30:        ubot = sp();
        !            31: 
        !            32:        
        !            33:        /*copy divisor */
        !            34:        for(work = divisor; work; work = work->s.CDR)
        !            35:                stack(work->s.I);
        !            36: 
        !            37:        vbot = sp();
        !            38:        stack(0);
        !            39:        if(*vbot < 0) {
        !            40:                negflag ^= 1;
        !            41:                dsmult(ubot-1,vbot,-1);
        !            42:        }
        !            43: 
        !            44:        /* check validity of data */
        !            45:        n = ubot - vbot;
        !            46:        m = utop - ubot - n - 1;
        !            47:        if (n == 1) {
        !            48:                /* do destructive division by  a single. */
        !            49:                rem = dsdiv(utop-1,ubot,*vbot);
        !            50:                if(negrem)
        !            51:                        rem = -rem;
        !            52:                if(negflag)
        !            53:                        dsmult(utop-1,ubot,-1);
        !            54:                if(remainder)
        !            55:                        *remainder = inewint(rem);
        !            56:                if(quotient)
        !            57:                        *quotient = export(utop,ubot);
        !            58:                return;
        !            59:        }
        !            60:        if (m < 0) {
        !            61:                if (remainder)
        !            62:                        *remainder = dividend;
        !            63:                if(quotient)
        !            64:                        *quotient = inewint(0);
        !            65:                return;
        !            66:        }
        !            67:        qbot = alloca(toint(utop) + toint(vbot) - 2 * toint(ubot));
        !            68: d1:
        !            69:        d = b /(*vbot +1);
        !            70:        dsmult(utop-1,ubot,d);
        !            71:        dsmult(ubot-1,vbot,d);
        !            72: 
        !            73: d2:    for(j=0,ujp=ubot; j <= m; j++,ujp++) {
        !            74: 
        !            75:        d3:     
        !            76:                qhat = calqhat(ujp,vbot);
        !            77:        d4:
        !            78:                if((borrow = mlsb(ujp + n, ujp, ubot, -qhat)) < 0) {
        !            79:                        adback(ujp + n, ujp, ubot);
        !            80:                        qhat--;
        !            81:                }
        !            82:                qbot[j] = qhat;
        !            83:        }
        !            84: d8:    if(remainder) {
        !            85:                dsdiv(utop, utop - n, d);
        !            86:                if(negrem) dsmult(utop-1,utop-n,-1);
        !            87:                *remainder = export(utop,utop-n);
        !            88:        }
        !            89:        if(quotient) {
        !            90:                if(negflag)
        !            91:                        dsmult(qbot+m,qbot,-1);
        !            92:                *quotient = export(qbot + m + 1, qbot);
        !            93:        }
        !            94: }
        !            95: /*
        !            96:  * asm code commented out due to optimizer bug
        !            97: calqhat(ujp,v1p)
        !            98: register int *ujp, *v1p;
        !            99: {
        !           100: asm("  movl    $0x3fffffff,r0");
        !           101: asm("  cmpl    (r10),(r11)");
        !           102: asm("  beql    on1");
        !           103: asm("  emul    (r11),$0x40000000,4(r11),r1");
        !           104: asm("  ediv    (r10),r1,r0,r5");
        !           105: asm("on1:");
        !           106: asm("  emul    r0,4(r10),$0,r1");
        !           107: asm("  emul    r5,$0x40000000,8(r11),r3");
        !           108: asm("  subl2   r3,r1");
        !           109: asm("  sbwc    r4,r2");
        !           110: asm("  bleq    out1");
        !           111: asm("  decl    r0");
        !           112: asm("out1:");
        !           113: }
        !           114: mlsb(utop,ubot,vtop,nqhat)
        !           115: register int *utop, *ubot, *vtop;
        !           116: register int nqhat;
        !           117: {
        !           118: asm("  clrl    r0");
        !           119: asm("loop2:    addl2   (r11),r0");
        !           120: asm("  emul    r8,-(r9),r0,r2");
        !           121: asm("  extzv   $0,$30,r2,(r11)");
        !           122: asm("  extv    $30,$32,r2,r0");
        !           123: asm("  acbl    r10,$-4,r11,loop2");
        !           124: }
        !           125: adback(utop,ubot,vtop)
        !           126: register int *utop, *ubot, *vtop;
        !           127: {
        !           128: asm("  clrl    r0");
        !           129: asm("loop3:    addl2   -(r9),r0");
        !           130: asm("  addl2   (r11),r0");
        !           131: asm("  extzv   $0,$30,r0,(r11)");
        !           132: asm("  extv    $30,$2,r0,r0");
        !           133: asm("  acbl    r10,$-4,r11,loop3");
        !           134: }
        !           135: dsdiv(top,bot,div)
        !           136: register int* bot;
        !           137: {
        !           138: asm("  clrl    r0");
        !           139: asm("loop4:    emul    r0,$0x40000000,(r11),r1");
        !           140: asm("  ediv    12(ap),r1,(r11),r0");
        !           141: asm("  acbl    4(ap),$4,r11,loop4");
        !           142: }
        !           143: dsmult(top,bot,mult)
        !           144: register int* top;
        !           145: {
        !           146: asm("  clrl    r0");
        !           147: asm("loop5:    emul    12(ap),(r11),r0,r1");
        !           148: asm("  extzv   $0,$30,r1,(r11)");
        !           149: asm("  extv    $30,$32,r1,r0");
        !           150: asm("  acbl    8(ap),$-4,r11,loop5");
        !           151: asm("  movl    r1,4(r11)");
        !           152: }
        !           153: lispval export(top,bot)
        !           154: register lispval bot;
        !           155: {
        !           156:        register r10, r9, r8, r7, r6;
        !           157: asm("  movl    4(ap),r10");
        !           158: asm("  movl    $0xC0000000,r4");
        !           159: asm("  jmp     Bexport");
        !           160: }
        !           161: */
        !           162: 
        !           163: #define MAXINT 0x8000000L
        !           164: 
        !           165: Ihau(fix)
        !           166: register int fix;
        !           167: {
        !           168:        register count;
        !           169:        if(fix==MAXINT)
        !           170:                return(32);
        !           171:        if(fix < 0)
        !           172:                fix = -fix;
        !           173:        for(count = 0; fix; count++)
        !           174:                fix /= 2;
        !           175:        return(count);
        !           176: }
        !           177: lispval
        !           178: Lhau()
        !           179: {
        !           180:        register count;
        !           181:        register lispval handy;
        !           182:        register dum1,dum2;
        !           183:        register struct argent *lbot, *np;
        !           184:        lispval Labsval();
        !           185: 
        !           186:        handy = lbot->val;
        !           187: top:
        !           188:        switch(TYPE(handy)) {
        !           189:        case INT:
        !           190:                count = Ihau(handy->i);
        !           191:                break;
        !           192:        case SDOT:
        !           193:                lbot->val = Labsval();
        !           194:                for(count = 0; handy->s.CDR!=((lispval) 0); handy = handy->s.CDR)
        !           195:                        count += 30;
        !           196:                count += Ihau(handy->s.I);
        !           197:                break;
        !           198:        default:
        !           199:                handy = errorh(Vermisc,"Haulong: bad argument",nil,
        !           200:                               TRUE,997,handy);
        !           201:                goto top;
        !           202:        }
        !           203:        return(inewint(count));
        !           204: }
        !           205: lispval
        !           206: Lhaipar()
        !           207: {
        !           208:        int *sp();
        !           209:        register lispval work;
        !           210:        register n;
        !           211:        register int *top = sp() - 1;
        !           212:        register int *bot;
        !           213:        register struct argent *lbot, *np;
        !           214:        int mylen;
        !           215: 
        !           216:        /*chkarg(2);*/
        !           217:        work = lbot->val;
        !           218:                                        /* copy data onto stack */
        !           219: on1:
        !           220:        switch(TYPE(work)) {
        !           221:        case INT:
        !           222:                stack(work->i);
        !           223:                break;
        !           224:        case SDOT:
        !           225:                for(; work!=((lispval) 0); work = work->s.CDR)
        !           226:                        stack(work->s.I);
        !           227:                break;
        !           228:        default:
        !           229:                work = errorh(Vermisc,"Haipart: bad first argument",nil,
        !           230:                                TRUE,996,work);
        !           231:                goto on1;
        !           232:        }
        !           233:        bot = sp();
        !           234:        if(*bot < 0) {
        !           235:                stack(0);
        !           236:                dsmult(top,bot,-1);
        !           237:                bot--;
        !           238:        }
        !           239:        for(; *bot==0 && bot < top; bot++);
        !           240:                                /* recalculate haulong internally */
        !           241:        mylen = (top - bot) * 30 + Ihau(*bot);
        !           242:                                /* get second argument            */
        !           243:        work = lbot[1].val;
        !           244:        while(TYPE(work)!=INT)
        !           245:                work = errorh(Vermisc,"Haipart: 2nd arg not int",nil,
        !           246:                                TRUE,995,work);
        !           247:        n = work->i;
        !           248:        if(n >= mylen || -n >= mylen)
        !           249:                goto done;
        !           250:        if(n==0) return(inewint(0));
        !           251:        if(n > 0) {
        !           252:                                /* Here we want n most significant bits
        !           253:                                   so chop off mylen - n bits */
        !           254:                stack(0);
        !           255:                n = mylen - n;
        !           256:                for(n; n >= 30; n -= 30)
        !           257:                        top--;
        !           258:                if(top < bot)
        !           259:                        error("Internal error in haipart #1",FALSE);
        !           260:                dsdiv(top,bot,1<<n);
        !           261: 
        !           262:        } else {
        !           263:                                /* here we want abs(n) low order bits */
        !           264:                stack(0);
        !           265:                bot = top + 1;
        !           266:                for(; n <= 0; n += 30)
        !           267:                        bot--;
        !           268:                n = 30 - n;
        !           269:                *bot &= ~ (-1<<n);
        !           270:        }
        !           271: done:
        !           272:        return(export(top + 1,bot));
        !           273: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.