[Date Prev][Date Next][Thread Prev][Thread Next]
[Author Index]
[Date Index]
[Thread Index]
[SQR-USERS Info]
[SQRUG Home Page]
Sample SQR Code - Sorting Arrays
- Subject: Sample SQR Code - Sorting Arrays
- From: Tony DeLia <tdelia@EROLS.COM>
- Date: Fri, 2 Oct 1998 13:09:16 -0400
- Organization: Tony DeLia
Hello...
Since there seems to be some interest in my SQR Tools Site I thought I'd
post a small sample. Here is some "snippets" of an Array Sorting
Algorithm.
I've also included my Assembler Version (Snippets) because I've included
comments and a brief narrative of the sorting process within the
program.
Also, maybe there are some old timers out there learning SQR!
The SQR Example sorts an array with a primary key (ARRkey), a secondary
key (ARRsec) and has the data stored in ARRrec (I used 1 field for
illustrative purposes). SORTptr is the main pointer- SCANptr is the
pointer for comparison. Hope nobody minds me posting to the site.
-Tony DeLia
!**********************************************************************
!* *
!* MODULE: SORT EXAMPLE. *
!* AUTHOR: TONY DELIA. *
!* DATE: 10/02/1998. *
!* SYSTEM: TD SQR UTILITY SERIES. *
!* DESC: SORTING ARRAYS. *
!* *
!**********************************************************************
..
..
do Define-Array
do Load-Array
do Sort-Array
..
..
!**********************************************************************
!* Define Array *
!**********************************************************************
begin-procedure Define-Array
create-array name=ARRdat size=2000 field=ARRrec:char -
field=ARRkey:char -
field=ARRsec:char
let #ARRmax = 2000
let #ARRctr = 0
end-procedure
!**********************************************************************
!* Load Array *
!**********************************************************************
begin-procedure Load-Array
let #ARRctr = 0
while 1 = 1
read #mmc-i-no into $rec:200
if #end-file = 1
break
end-if
.
.
put $rec $skey $ssec into ARRdat (#ARRctr) ARRrec ARRkey ARRsec
let #ARRctr = #ARRctr + 1
end-while
end-procedure
!**********************************************************************
!* Sort Array *
!**********************************************************************
begin-procedure Sort-Array
let #ARRmax = #ARRctr
let #SORTptr = 0
while #SORTptr < #ARRmax
let #SCANptr = #SORTptr + 1
get $SORTrec $SORTkey $SORTsec -
from ARRdat (#SORTptr) ARRrec ARRkey ARRsec
while #SCANptr < #ARRmax
get $SCANrec $SCANkey $SCANsec -
from ARRdat (#SCANptr) ARRrec ARRkey ARRsec
if ($SORTkey > $SCANkey)
or ($SORTkey = $SCANkey
and $SORTsec > $SCANsec)
put $SORTrec $SORTkey $SORTsec -
into ARRdat (#SCANptr) ARRrec ARRkey ARRsec
put $SCANrec $SCANkey $SCANsec -
into ARRdat (#SORTptr) ARRrec ARRkey ARRsec
let $SORTrec = $SCANrec
let $SORTkey = $SCANkey
let $SORTsec = $SCANsec
end-if
let #SCANptr = #SCANptr + 1
end-while
let #SORTptr = #SORTptr + 1
end-while
end-procedure
!**********************************************************************
Here's the Assembler Version (see comments for description of the
above process).
TITLE 'TDSRT - ASSEMBLER SORT TABLE // TONY DELIA'
***********************************************************************
* *
* MODULE: TDSRT. *
* AUTHOR: TONY DELIA. *
* DATE: 06/28/90. *
* DESC: SORT TABLE OF ELEMENTS. *
* *
***********************************************************************
.
.
***********************************************************************
* SORT TABLE *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
SORT EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
LH 5,SCTR LOAD ENTRY COUNT
CH 5,=H'1' ONLY 1 ENTRY ???
BE SORTX YES - EXIT SORT ROUTINE
*
BCTR 5,0 DECREMENT ENTRY COUNT BY 1
MH 5,=Y(SLEN) MULTIPLY BY ENTRY LENGTH
LA 5,STABLE(5) POINT TO LAST ENTRY
ST 5,SLAST SAVE LAST ENTRY ADDRESS
*
LA 4,STABLE INIT LO PTR - 1ST ENTRY
LA 5,SLEN(,4) INIT HI PTR - 2ND ENTRY
SORTIT EQU *
CLC 0(SLEN,4),0(5) IS LO ENTRY > HI ENTRY ??
BNH BUMPHI NO - BUMP HI PTR
XC 0(SLEN,4),0(5) YES - ISOLATE UNIQUE BITS
XC 0(SLEN,5),0(4) REPLACE LO WITH HI ENTRY
XC 0(SLEN,4),0(5) REPLACE HI WITH LO ENTRY
BUMPHI EQU *
LA 5,SLEN(,5) BUMP HI POINTER
C 5,SLAST HI POINTER PAST LIMIT ??
BNH SORTIT NO - COMPARE AGAIN
BUMPLO EQU *
LA 4,SLEN(,4) YES - BUMP LO POINTER
LA 5,SLEN(,4) RESET HI PTR = LO + 1
C 4,SLAST LO POINTER PAST LIMIT ??
BL SORTIT NO - KEEP SORTING
SORTX EQU *
L 6,SORT-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
* *
* BUBBLE SORT LOGIC: (LOW VALUES RISE LIKE BUBBLES TO TOP). *
* *
* INITIALLY, LO PTR (4) POINTS TO ENTRY 1 AND HI PTR (5) AT 2. *
* LO PTR WILL REMAIN THE SAME UNTIL HI PTR REACHES THE END OF *
* TABLE. EACH TIME HI PTR MOVES ALONG A COMPARE IS MADE WITH *
* LO PTR AND ELEMENTS MAY BE SWAPPED. THIS FORCES THE LOWEST *
* VALUE TO THE BEGINNING OF THE TABLE. THEN LO PTR IS BUMPED *
* TO THE NEXT ENTRY AND HI PTR IS RESET TO LO PTR + 1 ENTRY. *
* PROCESS IS THEN REPEATED FORCING THE NEXT LO VALUE TO 2ND *
* TABLE POSITION. THIS WILL REPEAT ITSELF UNTIL LO PTR HAS *
* REACHED THE LAST TABLE POSITION. NOTE THAT EACH TIME LO PTR *
* IS BUMPED, THE PRECEDING ELEMENTS ARE IN SORTED ORDER AND *
* ARE NO LONGER INCLUDED IN THE SORT PROCESS (TABLE SHRINKS). *
* *
***********************************************************************
EJECT
***********************************************************************
* TABLE *
***********************************************************************
SLEN EQU 2 TABLE ENTRY LENGTH
SLAST DC F'0' LAST ENTRY ADDRESS
SCTR DC H'0' NUMBER OF TABLE ENTRIES
STABLE DC 100CL2' ' 2-DIGIT TABLE
STABLEX DC X'FF' END-OF-TABLE MARKER
***********************************************************************
END TDSRT
--
Tony DeLia
AnswerThink Consulting Group
PeopleSoft Solutions Practice - Delphi Partners
tdelia@erols.com