Return to divbig.c CVS log

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

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

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

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