.TITLE SORT .IDENT /V01/ .ENABLE LC ; ; This module will sort an array of items by some specified key. ; Note that the order of items with the same key is not altered so that ; this routine may be called repeatedly to emulate a sort by multiple keys. ; ; Author: V01 11-Jun-80 Phil Stephensen-Payne ; ; Calling Sequence: ; ; This subroutine is called via the standard FORTRAN calling sequence as: ; ; CALL SORT(IDIR,ITYP,IKLN,IOFF,IFLN,ARRAY,INUM [,STATUS]) ; or ; STATUS = SORT(IDIR,ITYP,IKLN,IOFF,IFLN,ARRAY,INUM) ; ; Where: ; IDIR = Direction of Sort ; = 0 for Ascending, 1 for Descending ; ITYP = Type of element to sort ; = 0 for String element ; = +1 for signed byte, -1 for unsigned byte ; = +2 for signed word, -2 for unsigned word ; = +3 for signed doubleword, -3 for unsigned doubleword ; = +4 for signed single-precision floating-point ; = +5 for signed double-precision floating-point ; IKLN = Length of key in bytes (type 0 only) ; IOFF = Offset of key in array element (from 1) ; IFLN = Total size of field element in array ; ARRAY = Start address of array to sort ; INUM = Number of elements in the array ; STATUS = Optional error return ; ; All fields are assumed to be LOGICAL*1 except INUM which is INTEGER*2 ; ; Errors returned: ; ; STATUS = 0 if the operation was successful ; = -1 if a parameter error was detected ; ; External references: ; ; This module calls the subroutines PRMCHK ; ; ; Define the comparison routine for each type ; CMPTBL: .WORD CMPSTR ; Strings .WORD CMPBYT ; Bytes .WORD CMPWRD ; Words .WORD CMPDWD ; Double-words .WORD CMPFLT ; Floating-Point .WORD CMPDFL ; Double Floating CMPRTN: .WORD ; Store for comparison routine address ; ; Define the branch types for each option ; BRTBL: BLE .+2 ; Ascending Signed BGE .+2 ; Descending Signed BLOS .+2 ; Ascending Unsigned BHIS .+2 ; Descending Unsigned ; ; Define the lengths for each non-zero type ; LENTBL: .BYTE 1 ; Byte .BYTE 2 ; Word .BYTE 4 ; Doubleword .BYTE 4 ; Single-precision Floating .BYTE 8. ; Double-precision Floating SWAP: .BYTE ; Swap Flag .EVEN ; KLN: .WORD ; Key Length OFF: .WORD ; Offset of key FLN: .WORD ; Field Length ARR: .WORD ; Address of start of array NUM: .WORD ; Number of elements ; SORT:: MOV #8.,R0 ;CHECK NUMBER OF PARAMETERS CALL PRMCHK ; BCC 10$ ;IF CC parameters OK - carry on JMP END ;YES - EXIT IMMEDIATELY ; 10$: TST (R5)+ ; Ignore Number of Parameters ; ; Get and check Sort Direction - Must be 0 or 1 ; MOVB @(R5)+,R2 ; Get Sort Direction CMP R2,#1 ; Is it legal? BLOS 30$ ; If LOS yes - carry on ; 20$: MOV #-1,R0 ; No - parameter error JMP END ; Exit at once ; ; Get and check element type - in range -3 to +5 ; ; 30$: CLR R0 ; Initialise Sign Flag MOVB @(R5)+,R1 ; Get the type BGT 40$ ; If GT omit negative check CMP R1,#-3 ; Valid negative value? BLT 20$ ; If LT no - error ADD #2,R0 ; Flag an unsigned sort NEG R1 ; And set type positive ; 40$: CMP R1,#5 ; Valid type BHI 20$ ; If HI no - error ASL R1 ; Convert type to word offset MOV CMPTBL(R1),CMPRTN ; Store comparison routine address ADD R2,R0 ; Combine signed flag and sort direction ASL R0 ; Convert result to a word offset BIC #177400,BRANCH ; Clear Branch part of instruction BIS BRTBL(R0),BRANCH ; And insert the right sort of branch ;**** Note above instructions modify a later ;**** instruction (at BRANCH) ; ; Get the key length (from parameter or type) ; CLR KLN ; Initialise it MOVB @(R5)+,KLN ; Insert the parameter value ASR R1 ; Convert type to byte offset & test it BEQ 50$ ; If EQ string type - no default MOVB LENTBL-1(R1),KLN ; Overwrite with fixed length ; 50$: TST KLN ; Valid key length? BLE 20$ ; If LE no - error ; ; Get the key offset, field length, and array start ; CLR OFF ; Initialise offset MOVB @(R5)+,OFF ; And set from parameter BEQ 53$ ; If EQ 0 - assume he means 1 DEC OFF ; Set relative to 0 start ; 53$: CLR FLN ; Initialise field length MOVB @(R5)+,FLN ; And set from parameter BNE 55$ ; If NE OK - carry on MOV KLN,FLN ; Else set from key length ; 55$: MOV (R5)+,ARR ; Get address of array start ; ; Check that the key lies wholly within the field, and that for ; word-aligned data types the key is always word-aligned ; MOV KLN,R0 ; Get key length ADD OFF,R0 ; And hence offset of end of it CMP R0,FLN ; Does it all fit in the field? BHI 20$ ; If HI no - error CMP R1,#1 ; Word-aligned data type? BLOS 60$ ; If LOS no - omit check BIT #1,FLN ; Field length even? BNE 20$ ; If NE no - cannot work - error MOV OFF,R0 ; Yes - calculate address of first.. ADD ARR,R0 ; .. key BIT #1,R0 ; Word-aligned? BNE 20$ ; If NE no - error ; ; Check the number of elements is word-aligned and get it ; ; 60$: BIT #1,(R5) ; Parameter word-aligned? BNE 20$ ; If NE no - error MOV @(R5)+,NUM ; Yes - store the value ; ; Now we have validated all the parameters and can proceed with the sort. ; ; This version uses the simple "Ripple Sort" technique of checking ; adjacent cells and if they are out of sequence swapping them. ; For a totally disordered list this will result in n(n-1)/2 compares ; and swaps where n is the number of elements. ; SORTIT: CLRB SWAP ; Initialise Swap Flag MOV ARR,R5 ; Initialise first element address ADD OFF,R5 ; MOV R5,R4 ; Initialise next element address ADD FLN,R4 ; DEC NUM ; Count one less element to check this pass BLE OK ; If LE we've finished - exit MOV NUM,R3 ; Else get number to check this time ; CHKNXT: MOV R5,R0 ; Get addresses for comparison routine MOV R4,R1 ; MOV KLN,R2 ; And key length CALL @CMPRTN ; And call the relevant routine ; BRANCH: BR 20$ ; Do the necessary branch - the exact contents ; of this instruction depend on the sort of ; sort requested. INCB SWAP ; Set Swap Flag to initiate another pass MOV R5,R0 ; Get address of start of first element SUB OFF,R0 ; MOV R4,R1 ; Get address of start of second element SUB OFF,R1 ; MOV FLN,R2 ; Get length of field to move ; 10$: MOVB (R0),-(SP) ; Save byte of first element MOVB (R1),(R0)+ ; Move in byte of second element MOVB (SP)+,(R1)+ ; And overwrite second with first SOB R2,10$ ; And so on ; 20$: ADD FLN,R5 ; Set to next key ADD FLN,R4 ; SOB R3,CHKNXT ; If any more this pass, check next pair TSTB SWAP ; End of this pass - do we need another? BNE SORTIT ; 'Fraid so - go do it ; OK: CLR R0 ; Signal success ; END: RETURN ;EXIT TO USER ; ; Comparison Routines ; ; For all of these, on input R0 contains the address of the first ; variable, and R1 the address of the second variable. ; For CMPSTR R2 holds the number of bytes. ; On output from all routines the condition codes are set so that ; the main routine can do a BLE (or BLOS) meaningfully. ; Registers R0-R2 are assumed to be scratch. ; ; ; Compare Strings ; CMPSTR: CMPB (R0)+,(R1)+ ; These bytes the same? BNE 10$ ; If ne no - we've got the answer SOB R2,CMPSTR ; Yes - check the next one CLR R2 ; Force condition codes ; 10$: RETURN ; ; Compare Bytes ; CMPBYT: CMPB (R0),(R1) ; Set condition codes RETURN ; ; Compare Words ; CMPWRD: CMP (R0),(R1) ; Set condition codes RETURN ; ; Compare Doublewords ; CLZV=CLZ!CLV CMPDWD: MOV (R0),R2 ; Save first word CMP 2(R0),2(R1) BNE 10$ CMP (R0),(R1) BEQ 10$ ROR R2 ; Set the N-bit from the C-bit ASR R2 ; Save the N-bit ROL R2 ; Set the C-bit from the N-bit CLZV ; 10$: RETURN ; ; Compare Single-Precision Floating Point ; CMPFLT: MOV (R0),R2 ; Save it CMP (R0),(R1) BNE 5$ CMP 2(R0),2(R1) BEQ 10$ ; 5$: BIS (R1),R2 BCC 10$ NEG R2 ; 10$: RETURN ; ; Compare Double-Precision Floating-Point ; CLZN=CLZ!CLN ; CMPDFL: MOV (R0),R2 BIS (R1),R2 CMP (R0)+,(R1)+ BNE 10$ CMP (R0)+,(R1)+ BNE 10$ CMP (R0)+,(R1)+ BNE 10$ CMP (R0),(R1) BNE 10$ CLR R2 BR 20$ ; 10$: ROR R2 ROL R2 CLZN ; 20$: RETURN .END