Upload

Digital Research

MPM OPERATING SYSTEMS/MPM II/MPM II SOURCE/UTIL7/DSO.PLM

@@ -0,0 +1,158 @@
+$title ('SDIR - Sort')
+
+/*
+  Copyright (C) 1981
+  Digital Research
+  P.O. Box 579
+  Pacific Grove, CA 93950
+
+  Revised:
+    14 Sept 81 by Danny Horovitz
+*/
+
+dsort:
+do;
+                /* sort module for extended dir */
+
+                /* commonly used macros */
+
+declare dcl literally 'declare',
+        lit literally 'literally',
+        word lit 'address',
+        true literally '1',
+        false literally '0',
+        boolean literally 'byte',
+        cr literally '13',
+        lf literally '10';
+
+print: procedure(str$adr) external;
+dcl str$adr address;
+end print;
+
+dcl sorted boolean public;         /* set by this module if successful sort */
+
+declare
+        buf$fcb$adr address external,     /* index into directory buffer */
+        buf$fcb based buf$fcb$adr (32) byte,
+                                        /* fcb template for dir        */
+
+        (f$i$adr, end$adr, last$f$i$adr, x$i$adr, filesfound)
+             address external,
+                                    /* indices into file$info array    */
+        file$info based f$i$adr structure(
+            user byte,
+            name (8) byte,
+            type (3) byte,
+            bytes address,        /* byte count (mod kilobyte)        */
+            kbytes address,       /* kilobyte count                   */
+            recs$lword address,   /* record count is 3 byte value     */
+            recs$hbyte byte,      /* low word, high byte              */
+            hash$link address,
+            x$i$adr address),     /* index into time stamp array for  */
+                                  /* this file                        */
+        mid$adr address,
+        mid$file$info based mid$adr structure(
+            user byte,
+            name (8) byte,
+            type (3) byte,
+            bytes address,        /* byte count (mod kilobyte)        */
+            kbytes address,       /* kilobyte count                   */
+            recs$lword address,   /* record count is 3 byte value     */
+            recs$hbyte byte,      /* low word, high byte              */
+            hash$link address,
+            x$i$adr address);     /* index into time stamp array for  */
+                                  /* this file                        */
+
+mult23: procedure(index) address public;
+    dcl index address;   /* return address of file$info numbered by index */
+    return shl(index, 4) + shl(index,2) + shl(index,1) + index + end$adr +
+        size(file$info);
+        /* index * size(file$info) + base of file$info array */
+end mult23;
+
+lessthan: procedure( str1$adr, str2$adr) boolean;
+    dcl (i,c1,c2) byte,                   /* true if str1 < str2            */
+        (str1$adr, str2$adr) address,     /* sorting on name and type field */
+        str1 based str1$adr (1) byte,     /* only, assumed to be first in   */
+        str2 based str2$adr (1) byte;     /* file$info record */
+    do i = 0 to 10;
+        if (c1:=(str1(i) and 7fh)) <> (c2:=(str2(i) and 7fh)) then
+            return(c1 < c2);
+    end;
+    return(false);
+end lessthan;
+
+dcl f$i$indices$base address public,
+    f$i$indices based f$i$indices$base (1) address;
+
+qsort: procedure(l,r);
+dcl (l,r,i,j,temp) address,
+    stacksiz lit '14',     /* should always be able to sort 2 ** stacksiz */
+    stack (stack$siz) structure (l address, r address),
+    sp byte;
+
+    sp = 0; stack(0).l = l; stack(0).r = r;
+
+    do while sp < stack$siz - 1;
+        l = stack(sp).l; r = stack(sp).r; sp = sp - 1;
+        do while l < r;
+            i = l; j = r;
+            mi<6D>$adr <20> mult23(f$i$indices(shr(l+r,1))<29>;
+            do while i <= j;
+                f$i$adr = mult23(f$i$indices(i));
+                do while lessthan(f$i$adr,mid$adr);
+                    i = i + 1;
+                    f$i$adr = mult23(f$i$indices(i));
+                end;
+                f$i$adr = mult23(f$i$indices(j));
+                do while lessthan(mid$adr,f$i$adr);
+                    j = j - 1;
+                    f$i$adr = mult23(f$i$indices(j));
+                end;
+                if i <= j then
+                do; temp = f$i$indices(i); f$i$indices(i) = f$i$indices(j); 
+                    f$i$indices(j) = temp;
+                    i = i + 1;
+                    if j > 0 then j = j - 1;
+                end;
+            end;  /* while i <= j    */
+            if j - l < r - i then
+            do; if i < r then
+                do; sp = sp + 1; stack(sp).l = i; stack(sp).r = r;
+                end;
+                r = j;     /* continue sorting left partition */
+            end;
+            else
+            do; if l < j then
+                do; sp = sp + 1; stack(sp).l = l; stack(sp).r = j;
+                end;
+                l = i;     /* continue sorting right partition */
+            end;
+        end;      /* while l < r              */
+    end;          /* while sp < stack$siz - 1 */
+    if sp <> 255 then
+        call print(.(cr,lf,lf,'Sort Stack Overflow',cr,lf,'$'));
+    else sorted = true;
+end qsort;
+
+sort: procedure public;
+    dcl i address;
+    f$i$indices$base = last$f$i$adr + size(file$info);
+    if filesfound < 2 then
+        return;
+    if shr((x$i$adr - f$i$indices$base),1) < filesfound then
+    do;
+        call print(.(cr,lf,lf,'Not enough memory for sort',cr,lf,lf,'$'));
+        return;
+    end;
+    do i = 0 to filesfound - 1;
+        f$i$indices(i) = i;                       /* initialize f$i$indices */
+    end;
+    call qsort(0,filesfound - 1);
+    sorted = true;
+end sort;
+
+end dsort;
+
+                                     
+