× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



Now we are getting more ambitious. Here is a sorting program: 

DCL SPCPTR .PARM1 PARM;
DCL DD PARM1 CHAR(5) BAS(.PARM1);
    DCL DD PARM-NBR-ELEMENTS PKD(7,0) DEF(PARM1) POS(1);
    DCL DD PARM-DIRECTION    CHAR(1)  DEF(PARM1) POS(5); /* A OR D */

DCL SPCPTR .PARM2 PARM;
DCL DD ELEMENT(1) CHAR(20) BAS(.PARM2);

DCL OL PARMS(.PARM1, .PARM2) EXT PARM MIN(2);

DCL DD SWAP-FLAG  CHAR(1);
DCL DD JUMP-SIZE   BIN(4);
DCL DD SWEEP-END   BIN(4);
DCL DD ITEM-NBR    BIN(4);
DCL DD COMP-NBR    BIN(4);

ENTRY * (PARMS) EXT;
    OVRPGATR   1, 2; /* DON'T CONSTRAIN ARRAY REFS */
    CPYNV      JUMP-SIZE, PARM-NBR-ELEMENTS;
SORT-JUMP:
    CMPNV(B)   JUMP-SIZE,  1 /HI(SORT-SWEEP);
    CMPBLA(B)  SWAP-FLAG, "S"/NEQ(RETURN);
SORT-SWEEP:
    MULT(S)    JUMP-SIZE, 10;
    ADDN(S)    JUMP-SIZE,  3;
    DIV(S)     JUMP-SIZE, 13;
    SUBN       SWEEP-END, PARM-NBR-ELEMENTS, JUMP-SIZE;
    CPYBLA     SWAP-FLAG, " ";
    CPYNV(B)   ITEM-NBR, 0/ZER(SORT-COMPARE);

SORT-SWAP:
    EXCHBY     ELEMENT(ITEM-NBR), ELEMENT(COMP-NBR);
    CPYBLA     SWAP-FLAG, "S";
SORT-COMPARE:
    ADDN(S)    ITEM-NBR, 1;
    CMPNV(B)   ITEM-NBR, SWEEP-END/HI(SORT-JUMP);
    ADDN       COMP-NBR, ITEM-NBR, JUMP-SIZE;
    CMPBLA(B)  PARM-DIRECTION, "D"/EQ(DESCENDING-SORT-COMPARE);
ASCENDING-SORT-COMPARE:
    CMPBLA(B)  ELEMENT(ITEM-NBR), ELEMENT(COMP-NBR)
               /HI(SORT-SWAP),    NHI(SORT-COMPARE);
DESCENDING-SORT-COMPARE:
    CMPBLA(B)  ELEMENT(ITEM-NBR), ELEMENT(COMP-NBR)
               /LO(SORT-SWAP),    NLO(SORT-COMPARE);

RETURN:
    RTX        *;

PEND;

And here is a simple driver program that calls it:

DCL DD RESOLVE-PG CHAR(34);
    DCL DD RESOLVE-TYPE CHAR( 2) DEF(RESOLVE-PG) POS( 1) INIT(X'0201');
    DCL DD RESOLVE-NAME CHAR(30) DEF(RESOLVE-PG) POS( 3);
    DCL DD RESOLVE-AUTH CHAR( 2) DEF(RESOLVE-PG) POS(33) INIT(X'0000');

DCL SPCPTR .PARM1 INIT(PARM1);
DCL DD      PARM1 CHAR(5);
    DCL DD  PARM-NBR-ELEMENTS PKD(7,0) DEF(PARM1) POS(1);
    DCL DD  PARM-DIRECTION    CHAR(1)  DEF(PARM1) POS(5);

DCL SPCPTR .PARM2 INIT(PARM2);
DCL DD      PARM2(500000) ZND(20,0);

DCL SYSPTR .COMBSORT;
DCL OL COMBSORT(.PARM1, .PARM2) ARG;

DCL DD NBR BIN(4);
DCL DD MAX BIN(4) INIT(500000);

ENTRY * EXT;
RESOLVE-PGMS:
    CPYNV      NBR, 0;
NEXT:
    ADDN(S)    NBR, 1;
    SUBN       PARM2(NBR), 1000000, NBR;
    CMPNV(B)   NBR, MAX/LO(NEXT);

    CPYBLAP    RESOLVE-NAME, "COMBSORT" , " ";
    RSLVSP    .COMBSORT, RESOLVE-PG, *, *;
    CPYNV      PARM-NBR-ELEMENTS, P'500000';
    CPYBLA     PARM-DIRECTION, "A";
    CALLX     .COMBSORT, COMBSORT, *;
    RTX        *;

PEND;


On my little model 150, the sorting program sorts 500,000 elements in 55
seconds.
This is quite a respectable performance.

Later on, we can add refinements that sort on a part of the element, that
sort
on a sortkey given as a separate array, and the like.


+---
| This is the MI Programmers Mailing List!
| To submit a new message, send your mail to MI400@midrange.com.
| To subscribe to this list send email to MI400-SUB@midrange.com.
| To unsubscribe from this list send email to MI400-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: dr2@cssas400.com
+---


As an Amazon Associate we earn from qualifying purchases.

This thread ...


Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.