Research V5 development

Work on file usr/source/s3/gamma.s
Work on file usr/sys/seg.h
Work on file usr/source/s2/uniq.c
Work on file usr/source/s3/qsort.s

Co-Authored-By: Dennis Ritchie <dmr@research.uucp>
Synthesized-from: v5

diff --git a/usr/source/s2/uniq.c b/usr/source/s2/uniq.c
new file mode 100644 (file)
index 0000000..38373f0
--- /dev/null
+++ b/usr/source/s2/uniq.c
@@ -0,0 +1,162 @@
+fields 0;
+letters 0;
+linec;
+mode;
+uniq;
+
+main(argc, argv)
+int argc;
+char *argv[];
+{
+       extern fin, fout;
+       int f;
+       static char b1[1000], b2[1000];
+
+loop:
+       if(argc > 1) {
+               if(*argv[1] == '-') {
+                       if(argv[1][1] <= '9')
+                               fields = conv(&argv[1][1]);
+                       else mode = argv[1][1];
+                       argc--;
+                       argv++;
+                       goto loop;
+               }
+               if(*argv[1] == '+') {
+                       letters = conv(&argv[1][1]);
+                       argc--;
+                       argv++;
+                       goto loop;
+               }
+               f = open(argv[1], 0);
+               if(f < 0) {
+                       printf("cannot open %s\n", argv[1]);
+                       exit();
+               }
+               fin = f;
+       } else
+               fin = dup(0);
+       if(argc > 2) {
+               f = creat(argv[2], 0666);
+               if(f < 0) {
+                       printf("cannot create %s\n", argv[2]);
+                       exit();
+               }
+               fout = f;
+       } else
+               fout = dup(1);
+       close(0);
+       close(1);
+       gline(b1);
+l1:
+       linec++;
+       if(gline(b2)) {
+               pline(b1);
+               flush();
+               exit();
+       }
+       if(equal(b1, b2)) goto l1;
+       pline(b1);
+       linec = 0;
+l2:
+       linec++;
+       if(gline(b1)) {
+               pline(b2);
+               flush();
+               exit();
+       }
+       if(equal(b1, b2)) goto l2;
+       pline(b2);
+       linec = 0;
+       goto l1;
+}
+
+gline(buf)
+char buf[];
+{
+       int c;
+
+       while((c = getchar()) != '\n') {
+               if(c == '\0')
+                       return(1);
+               *buf++ = c;
+       }
+       *buf = 0;
+       return(0);
+}
+
+pline(buf)
+char buf[];
+{
+       int c;
+
+       switch(mode) {
+
+       case 'u':
+               if(uniq) {;
+                       uniq = 0;
+                       return;
+               }
+               break;
+
+       case 'd':
+               if(uniq) break;
+               return;
+
+       case 'c':
+               printf("%4d ", linec);
+       }
+       uniq = 0;
+       while((c = *buf++) != 0)
+               putchar(c);
+       putchar('\n');
+}
+
+equal(b1, b2)
+char b1[], b2[];
+{
+       int c;
+
+       b1 = skip(b1);
+       b2 = skip(b2);
+       while((c = *b1++) != 0)
+               if(c != *b2++) return(0);
+       if(*b2 != 0)
+               return(0);
+       uniq++;
+       return(1);
+}
+
+char *
+skip(s)
+char *s;
+{
+       int nf, nl;
+
+       nf = nl = 0;
+       while(nf++ < fields) {
+               while(*s==' ' || *s=='\t')
+                       s++;
+               while( !(*s==' ' || *s=='\t') ) 
+                       if(*s == 0) return(s);
+                       else s++;
+       }
+       while(nl++ < letters) 
+                       if(*s == 0) return(s);
+                       else s++;
+       return(s);
+}
+
+conv(s)
+char *s;
+{
+       int d, n;
+
+       n = 0;
+       for(;;) {
+               d = *s++ - '0';
+               if(0>d || d>9) break;
+               n = n*10 + d;
+       }
+       return(n);
+}

diff --git a/usr/source/s3/gamma.s b/usr/source/s3/gamma.s
new file mode 100644 (file)
index 0000000..d378aa1
--- /dev/null
+++ b/usr/source/s3/gamma.s
@@ -0,0 +1,320 @@
+.globl gamma, signgam, _signgam
+.globl log, sin
+half = 040000
+one = 40200
+two = 40400
+eight = 41000
+large = 77777
+ldfps = 170100^tst
+stfps = 170200^tst
+/
+/      gamma computes the log of the abs of the gamma function.
+/      gamma accepts its argument and returns its result
+/      in fr0.  The carry bit is set if the result is
+/      too large to represent.
+/      The sign of the gamma function is
+/      returned in the globl cell signgam.
+/
+/      The coefficients for expansion around zero
+/      are #5243 from Hart & Cheney; for expansion
+/      around infinity they are #5404.
+/
+/      movf    arg,fr0
+/      jsr     r5,gamma
+/      movf    fr0,...
+/
+gamma:
+       stfps   -(sp)
+       ldfps   $200
+       clr     signgam
+       movf    fr1,-(sp)
+       tstf    fr0
+       cfcc
+       ble     negative
+       cmpf    $eight,fr0
+       cfcc
+       blt     asymptotic
+       jsr     r5,regular
+/
+lret:
+       jsr     r5,log
+       bec     ret
+       4
+ret:
+       movf    (sp)+,fr1
+       ldfps   (sp)+
+       clc
+       rts     r5
+/
+erret:
+       movf    $large,fr0
+       movf    (sp)+,fr1
+       ldfps   (sp)+
+       sec
+       rts     r5
+
+/
+/      here for positive x > 8
+/      the log of the gamma function is
+/      approximated directly by the asymptotic series.
+/
+asymptotic:
+       movf    fr0,-(sp)
+       movf    fr0,fr1
+       jsr     r5,log
+       subf    $half,fr1
+       mulf    fr1,fr0
+       subf    (sp),fr0
+       addf    goobie,fr0
+/
+       movf    $one,fr1
+       divf    (sp)+,fr1
+       movf    fr0,-(sp)
+       movf    fr1,-(sp)
+       mulf    fr1,fr1
+/
+       mov     r0,-(sp)
+       mov     $p5p,r0
+       mov     $5,-(sp)
+       movf    *(r0)+,fr0
+1:
+       mulf    fr1,fr0
+       addf    *(r0)+,fr0
+       dec     (sp)
+       bne     1b
+       tst     (sp)+
+       mov     (sp)+,r0
+       mulf    (sp)+,fr0
+       addf    (sp)+,fr0
+       br      ret
+
+/
+/      here on negative
+/      the negative gamma is computed
+/      in terms of the pos gamma.
+/
+negative:
+       absf    fr0
+       movf    fr0,fr1
+       mulf    pi,fr0
+       jsr     r5,sin
+       negf    fr0
+       cfcc
+       beq     erret
+       bgt     1f
+       inc     signgam
+       absf    fr0
+1:
+       mov     signgam,-(sp)
+       mulf    fr1,fr0
+       divf    pi,fr0
+       jsr     r5,log
+       movf    fr0,-(sp)
+       movf    fr1,fr0
+       jsr     r5,gamma
+       addf    (sp)+,fr0
+       negf    fr0
+       mov     (sp)+,signgam
+       br      ret
+
+/
+/      control comes here for arguments less than 8.
+/      if the argument is 2<x<3 then compute by
+/      a rational approximation.
+/      if x<2 or x>3 then the argument
+/      is reduced in range by the formula
+/      gamma(x+1) = x*gamma(x)
+/
+regular:
+       subf    $two,fr0
+       cfcc
+       bge     1f
+       addf    $two,fr0
+       movf    fr0,-(sp)
+       addf    $one,fr0
+       movf    fr0,-(sp)
+       addf    $one,fr0
+       jsr     r5,regular
+       divf    (sp)+,fr0
+       divf    (sp)+,fr0
+       rts     r5
+1:
+       cmpf    $one,fr0
+       cfcc
+       bgt     1f
+       addf    $one,fr0
+       movf    fr0,-(sp)
+       subf    $two,fr0
+       jsr     r5,1b
+       mulf    (sp)+,fr0
+       rts     r5
+1:
+       movf    fr2,-(sp)
+       mov     r0,-(sp)
+       mov     $p4p,r0
+       mov     $6,-(sp)
+       movf    fr0,fr2
+       movf    *(r0)+,fr0
+1:
+       mulf    fr2,fr0
+       addf    *(r0)+,fr0
+       dec     (sp)
+       bne     1b
+       mov     $7,(sp)
+       movf    fr2,fr1
+       br      2f
+1:
+       mulf    fr2,fr1
+2:
+       addf    *(r0)+,fr1
+       dec     (sp)
+       bne     1b
+       tst     (sp)+
+       mov     (sp)+,r0
+       divf    fr1,fr0
+       movf    (sp)+,fr2
+       rts     r5
+/
+p4p:
+       p6;p5;p4;p3;p2;p1;p0
+       q6;q5;q4;q3;q2;q1;q0
+
+/      p6 = -.67449 50724 59252 89918 d1
+/      p5 = -.50108 69375 29709 53015 d2
+/      p4 = -.43933 04440 60025 67613 d3
+/      p3 = -.20085 27401 30727 91214 d4
+/      p2 = -.87627 10297 85214 89560 d4
+/      p1 = -.20886 86178 92698 87364 d5
+/      p0 = -.42353 68950 97440 89647 d5
+/      q7 = 1.0 d0
+/      q6 = -.23081 55152 45801 24562 d2
+/      q5 = +.18949 82341 57028 01641 d3
+/      q4 = -.49902 85266 21439 04834 d3
+/      q3 = -.15286 07273 77952 20248 d4
+/      q2 = +.99403 07415 08277 09015 d4
+/      q1 = -.29803 85330 92566 49932 d4
+/      q0 = -.42353 68950 97440 90010 d5
+p1:
+       143643
+       26671
+       36161
+       72154
+p2:
+       143410
+       165327
+       54121
+       172630
+p3:
+       142773
+       10340
+       74264
+       152066
+p4:
+       142333
+       125113
+       176657
+       75740
+p5:
+       141510
+       67515
+       65111
+       24263
+p6:
+       140727
+       153242
+       163350
+       32217
+p0:
+       144045
+       70660
+       101665
+       164444
+q1:
+       143072
+       43052
+       50302
+       136745
+q2:
+       43433
+       50472
+       145404
+       175462
+q3:
+       142677
+       11556
+       144553
+       154177
+q4:
+       142371
+       101646
+       141245
+       11264
+q5:
+       42075
+       77614
+       43022
+       27573
+q6:
+       141270
+       123404
+       76130
+       12650
+q0:
+       144045
+       70660
+       101665
+       164444
+
+p5p:
+       s5;s4;s3;s2;s1;s0
+/
+/      s5 = -.16334 36431 d-2
+/      s4 = +.83645 87892 2 d-3
+/      s3 = -.59518 96861 197 d-3
+/      s2 = +.79365 05764 93454 d-3
+/      s1 = -.27777 77777 35865 004 d-2
+/      s0 = +.83333 33333 33331 01837 d-1
+/      goobie = 0.91893 85332 04672 74178 d0
+s5:
+       135726
+       14410
+       15074
+       17706
+s4:
+       35533
+       42714
+       111634
+       76770
+s3:
+       135434
+       3200
+       171173
+       156141
+s2:
+       35520
+       6375
+       12373
+       111437
+s1:
+       136066
+       5540
+       132625
+       63540
+s0:
+       37252
+       125252
+       125252
+       125047
+goobie:
+       40153
+       37616
+       41445
+       172645
+pi:
+       40511
+       7732
+       121041
+       64302
+.bss
+_signgam:
+signgam:.=.+2

diff --git a/usr/source/s3/qsort.s b/usr/source/s3/qsort.s
new file mode 100644 (file)
index 0000000..237ab22
--- /dev/null
+++ b/usr/source/s3/qsort.s
@@ -0,0 +1,146 @@
+/
+/ copyright 1972 bell telephone laboratories inc.
+/
+
+/ quicker sort
+
+/      mov     $base,r1
+/      mov     $base+[n*width],r2
+/      mov     $width,r3
+/      jsr     pc,qsort
+
+/      r0,r1,r2,r3,r4 are used
+
+.globl qsort
+.globl compare
+
+qsort:
+       mov     r5,-(sp)
+       mov     r4,-(sp)
+       bit     $1,r3
+       bne     1f
+       bit     $1,r1
+       bne     1f
+       cmp     r3,$2
+       bne     2f
+       mov     $exch1,exchange
+       br      3f
+2:
+       mov     r3,r5
+       clc
+       ror     r5
+       mov     r5,width
+       mov     $exchw,exchange
+       br      3f
+1:
+       mov     $exchb,exchange
+3:
+       jsr     pc,qs1
+       mov     (sp)+,r4
+       mov     (sp)+,r5
+       rts     pc
+
+qs1:
+       mov     r1,r5
+       neg     r5
+       add     r2,r5
+       bgt     1f
+       rts     pc
+1:
+       clr     r4
+       dvd     r3,r4
+       asr     r4
+       mpy     r3,r4
+       mov     r5,r4
+       add     r1,r4
+
+       mov     r1,-(sp)
+       mov     r2,-(sp)
+
+loop:
+       cmp     r1,r4
+       bhis    loop1
+       mov     r1,r0
+       jsr     pc,compare
+       bgt     loop1
+       add     r3,r1
+       br      loop
+
+loop1:
+       cmp     r2,r4
+       blos    1f
+       sub     r3,r2
+       mov     r2,r0
+       jsr     pc,compare
+       bge     loop1
+
+       jsr     pc,*exchange
+       cmp     r1,r4
+       bne     loop
+       mov     r2,r4
+       br      loop
+
+1:
+       cmp     r1,r4
+       beq     1f
+       jsr     pc,*exchange
+       mov     r1,r4
+       br      loop1
+
+1:
+       mov     (sp)+,r2
+       mov     r4,-(sp)
+       mov     r4,r1
+       add     r3,r1
+       mov     r2,r0
+       sub     r1,r0
+       sub     2(sp),r4
+       cmp     r0,r4
+       blo     1f
+       mov     (sp)+,r0
+       mov     (sp)+,r4
+       mov     r1,-(sp)
+       mov     r2,-(sp)
+       mov     r0,r2
+       mov     r4,r1
+1:
+       jsr     pc,qs1
+       mov     (sp)+,r2
+       mov     (sp)+,r1
+       br      qs1
+
+exchb:
+       mov     r1,-(sp)
+       mov     r2,-(sp)
+       mov     r3,r5
+1:
+       movb    (r1),r0
+       movb    (r2),(r1)+
+       movb    r0,(r2)+
+       sob     r5,1b
+       mov     (sp)+,r2
+       mov     (sp)+,r1
+       rts     pc
+
+exchw:
+       mov     r1,-(sp)
+       mov     r2,-(sp)
+       mov     width,r5
+1:
+       mov     (r1),r0
+       mov     (r2),(r1)+
+       mov     r0,(r2)+
+       sob     r5,1b
+       mov     (sp)+,r2
+       mov     (sp)+,r1
+       rts     pc
+
+exch1:
+       mov     (r1),r0
+       mov     (r2),(r1)
+       mov     r0,(r2)
+       rts     pc
+
+.bss
+exchange: .=.+2
+width: .=.+2

diff --git a/usr/sys/seg.h b/usr/sys/seg.h
new file mode 100644 (file)
index 0000000..77dafed
--- /dev/null
+++ b/usr/sys/seg.h
@@ -0,0 +1,18 @@
+/*
+ *     Copyright 1973 Bell Telephone Laboratories Inc
+ */
+
+/*
+ * KT-11 registers
+ */
+
+#define        UISD    0177600
+#define        UISA    0177640
+#define        RO      02
+#define        RW      06
+#define        WO      04
+#define        ED      010
+struct {
+       int     r[8];
+};
+int    *ka6;