; Copyright 1996 Acorn Computers Ltd
;
; Licensed under the Apache License, Version 2.0 (the "License");
; you may not use this file except in compliance with the License.
; You may obtain a copy of the License at
;
; http://www.apache.org/licenses/LICENSE-2.0
;
; Unless required by applicable law or agreed to in writing, software
; distributed under the License is distributed on an "AS IS" BASIS,
; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
; See the License for the specific language governing permissions and
; limitations under the License.
;
SUBT > HeapSort
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; HeapSort routine. Borrowed from Knuth by Tutu. Labels h(i) correspond to
; steps in the algorithm.
;mjs June 2001, API adjusted to allow for full 32-bit addresses
; In r0 = n (maximum of 268,435,455), and flags in top 4 bits
; bit 31 *must* be set, flagging new API to allow full 32-bit addresses
; bit 30 set -> use r4,r5 on postpass
; bit 29 set -> build (r1) from r4,r5 in prepass
; bit 28 set -> use r6 as temp slot
; r1 = array(n) of word size objects (r2 determines type)
; r2 = address of comparison procedure
; Special cases:
; 0 -> treat r(n) as array of cardinal
; 1 -> treat r(n) as array of integer
; 2 -> treat r(n) as array of cardinal*
; 3 -> treat r(n) as array of integer*
; 4 -> treat r(n) as array of char* (case insensitive)
; 5 -> treat r(n) as array of char* (case sensitive)
; r3 = wsptr for comparison procedure (only needed if r2 > 5)
; r4 = array(n) of things (only needed if r0 & &60000000)
; r5 = sizeof(element) ( --------- ditto ---------- )
; r6 = address of temp slot (only needed if r5 > 16K or r0 & &10000000)
;For backward compatibility, supports old API assuming addresses are safe
;(specifically, that address in r1 does not have any of top 3 bits set)
;
;The old API uses bits 31-29 of r1 to mean the equivalent of bits 30-28 of r0
;as defined above. Just to make this more confusing, the old API always behaves
;as if bit 31 of r1 mirrors bit 30 (ie. bit 30 set forces bit 31 set, see PRM 5a-662),
;so we preserve this for old API, but do originally intended thing for new API.
; r10-r12 trashable
hs_array RN r4
hs_procadr RN r5
hs_i RN r6
hs_j RN r7
hs_K RN r8
hs_R RN r9
hs_l RN r10
hs_r RN r11
;wp RN r12
; User sort procedure entered in SVC mode, interrupts enabled
; r0 = contents of array(1)
; r1 = contents of array(2)
; r0-r3 may be trashed
; wp = value requested (trash at your peril; you'll get the bad one next time)
; User sort procedure returns:
; LT: if f(r0) < f(r1)
; GE: if f(r0) => f(r1)
; (ie. N_bit and V_bit only considered)
HeapSortRoutine ROUT
BIC r10, r0, #&F0000000 ; n (zapping flag bits)
CMP r10, #2 ; 0 or 1 elements? No data moved either
ExitSWIHandler LO ; VClear in lr and psr
Push "r0-r3, hs_array, hs_procadr, hs_i, hs_j, hs_K, hs_R, lr"
CLRPSR I_bit, r14 ; Enable interrupts (may take ages)
[ False
STR r0, ndump ; For debugging porpoises
]
TST r0, #&80000000 ; test old/new API
MOVNE r10, r0 ; new, flags are in r0
BICNE r0, r0, #&F0000000 ; zap new flags
MOVEQ r10, r1, LSR #1 ; old, flags are in r1, 1 bit to left
BICEQ r1, r1, #&E0000000 ; zap old flags
TST r10, #&20000000 ; Are we to build the pointer array?
BEQ %FT01
; Build array of pointers to data blocks for the punter if he desires this
; (lazy slobs abound ...)
; for (i=0; i<n; i++) r(i) = &block + i*sizeof(element);
MOV r10, r0 ; n
MOV r14, r1 ; r14 -> base of pointer array
00 STR r4, [r14], #4
ADD r4, r4, r5 ; r4 += sizeof(element)
SUBS r10, r10, #1
BNE %BT00
01 SUB hs_array, r1, #4 ; HeapSort assumes r(1..n) not (0..n-1)
MOV hs_procadr, r2 ; Put proc address where we need it
CMP hs_procadr, #6 ; Special procedure ?
ADRLO r14, hs_Procedures
LDRLO hs_procadr, [r14, hs_procadr, LSL #2]
ADDLO hs_procadr, hs_procadr, r14
MOV wp, r3 ; Can now use r3 temp. Keep set up
; for speed during execution
MOV hs_l, r0, LSR #1 ; l = floor(n/2) + 1
ADD hs_l, hs_l, #1
MOV hs_r, r0 ; r = n
h2 CMP hs_l, #1
BEQ %FT10
SUB hs_l, hs_l, #1
LDR hs_R, [hs_array, hs_l, LSL #2] ; R = R(l)
MOV hs_K, hs_R
B %FT20
10 LDR hs_R, [hs_array, hs_r, LSL #2] ; R = R(r)
MOV hs_K, hs_R
LDR r14, [hs_array, #4] ; R(r) = R(1)
STR r14, [hs_array, hs_r, LSL #2]
SUB hs_r, hs_r, #1
CMP hs_r, #1 ; IF r=1 THEN R(1) = R
STREQ hs_R, [hs_array, #4]
20
[ False
BL DoDebug
]
CMP hs_r, #1
BEQ %FT90 ; [finished sorting the array]
h3 MOV hs_j, hs_l
h4 MOV hs_i, hs_j
MOV hs_j, hs_j, LSL #1
[ False
DREG hs_i," i ",cc
DREG hs_j," j "
]
CMP hs_j, hs_r
BEQ h6
BHI h8
h5 LDR r0, [hs_array, hs_j, LSL #2]
; IF K(R(j)) < K(R(j+1)) THEN j +:= 1
ADD r14, hs_j, #1
LDR r1, [hs_array, r14, LSL #2]
MOV lr, pc ; r0, r1 for comparison
MOV pc, hs_procadr
ADDLT hs_j, hs_j, #1 ; Assumes signed comparison done <<<<<<
h6 MOV r0, hs_K ; IF K >= K(R(j)) THEN h8
LDR r1, [hs_array, hs_j, LSL #2]
MOV lr, pc ; r0, r1 for comparison
MOV pc, hs_procadr
LDRLT r14, [hs_array, hs_j, LSL #2] ; R(i) = R(j)
STRLT r14, [hs_array, hs_i, LSL #2]
BLT h4
h8 STR hs_R, [hs_array, hs_i, LSL #2] ; R(i) = R
B h2
; Array now sorted into order
90 LDR r14, [sp, #4*0] ; r0in
LDR r2, [sp, #4*1] ; r1in
TST r14, #&80000000 ; check for old/new API
ANDEQ r8, r2, #&E0000000
ORREQ r14, r14, r8, LSR #1 ; old, munge old flag bits into r14
BICEQ r2, r2, #&E0000000 ; clear from r2
ORREQ r14, r14, #&40000000 ; ho hum fudge to make old bit 31 mirror
TSTEQ r14, #&20000000 ; old bit 30 if using old API (behave as errata
BICEQ r14, r14, #&40000000 ; in PRM 5a-662)
TST r14, #&40000000 ; check for postpass
BEQ %FA99 ; [no shuffle required, exit]
; Reorder the blocks according to the sorted array of pointers
ADD r1, sp, #4*4
LDMIA r1, {r1, r8, r9} ; r4,r5,r6in
; r1 -> list of blocks
[ False
DREG r2, "pointer array "
DREG r1, "base of blocks "
DREG r8, "sizeof(element) "
]
MOV r3, r2 ; r3 -> first item of current cycle
BIC r0, r14, #&F0000000 ; r0 = n
ADD r6, r2, r0, LSL #2 ; r6 -> end of array of pointers
TST r14, #&10000000 ; punter forcing use of his temp slot?
BNE %FT94 ; fine by me!
CMP r8, #ScratchSpaceSize
LDRLS r9, =ScratchSpace ; r9 -> temp slot (normally ScratchSpc)
94
[ False
DREG r9, "temp slot "
]
91 SUB r14, r3, r2
MOV r14, r14, LSR #2 ; r14 = index (0..n-1) of current item
MLA r4, r14, r8, r1 ; r4 -> current block
MOV r5, r3 ; r5 -> current item
BL MoveToTempSlot ; save first block in temp slot
92 LDR r7, [r5] ; r7 -> next block
MOV r14, #0
STR r14, [r5] ; mark item 'done'
SUB r5, r7, r1 ; r14 := index of next item (r8 pres.)
DivRem r14, r5, r8, r0 ; r5,r0 corrupt
ADD r5, r2, r14, LSL #2 ; r5 -> next item
[ False
DREG r7, " next block "
DREG r5, " next item "
]
CMP r5, r3 ; reached start of cycle?
MOVEQ r7, r9 ; get back from temp slot if last one
BL MoveFromGivenSlot ; corrupts flags, but preserves r5, r3...
CMP r5, r3
MOVNE r4, r7 ; update r4 (current block)
BNE %BT92
93 LDR r14, [r3, #4]! ; skip already-copied items
CMP r3, r6
BCS %FA99 ; [reached end]
CMP r14, #0
BEQ %BT93
B %BT91 ; [found one that hasn't been copied]
; No error return from HeapSort
99 Pull "r0-r3, hs_array, hs_procadr, hs_i, hs_j, hs_K, hs_R, lr"
; SWIHandler exit takes flags + mode from lr, not psr !!!
ExitSWIHandler
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; In r4 -> element to be copied
; r8 = sizeof(element)
; r9 -> temp slot
; Out all preserved
MoveToTempSlot Entry "r4, r8, r9"
TST r4, #3 ; If base and element size wordy
TSTEQ r8, #3 ; then do faster copy. Also temp wordy
BNE %FT01
00 SUBS r8, r8, #4
LDRPL r14, [r4], #4
STRPL r14, [r9], #4
BPL %BT00
EXIT
01 SUBS r8, r8, #1
LDRPLB r14, [r4], #1
STRPLB r14, [r9], #1
BPL %BT01
EXIT
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; In r4 -> where element is to be copied
; r7 -> element to be copied
; r8 = sizeof(element)
; Out all preserved
MoveFromGivenSlot Entry "r4, r7, r8"
TST r4, #3 ; If dest and element size wordy
TSTEQ r8, #3 ; then do faster copy. Also src wordy
BNE %FT01
00 SUBS r8, r8, #4
LDRPL r14, [r7], #4
STRPL r14, [r4], #4
BPL %BT00
EXIT
01 SUBS r8, r8, #1
LDRPLB r14, [r7], #1
STRPLB r14, [r4], #1
BPL %BT01
EXIT
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Built-in sorting procedures
hs_Procedures
DCD hs_CardinalCMP - hs_Procedures
DCD hs_IntegerCMP - hs_Procedures
DCD hs_CardinalPtrCMP - hs_Procedures
DCD hs_IntegerPtrCMP - hs_Procedures
DCD hs_StringCMP - hs_Procedures
DCD hs_StringSensCMP - hs_Procedures
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; In r0, r1 -> cardinals
; Out flags set on (*r0) - (*r1)
hs_CardinalPtrCMP
LDR r0, [r0]
LDR r1, [r1]
; .............................................................................
; In r0, r1 = cardinals
; Out flags set on r0 - r1
hs_CardinalCMP
CMP r0, r1
MSRCS CPSR_f, #C_bit ; CS -> GE (nv)
MSRCC CPSR_f, #N_bit ; CC -> LT (Nv)
MOV pc, lr
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; In r0, r1 -> integers
; Out flags set on (*r0) - (*r1)
hs_IntegerPtrCMP
LDR r0, [r0]
LDR r1, [r1]
; .............................................................................
; In r0, r1 = integers
; Out flags set on r0 - r1
hs_IntegerCMP
CMP r0, r1
MOV pc, lr
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Case-insensitive string comparison
; In r0, r1 -> strings - CtrlChar terminated (NB. Must be same CtrlChar !)
; Out flags set on (char *)(r0) - (char *)(r1) compare
hs_StringCMP ROUT
10 LDRB r2, [r0], #1
LowerCase r2, r12
LDRB r3, [r1], #1
LowerCase r3, r12
CMP r2, r3 ; Differ ?
MOVNE pc, lr ; GE or LT
CMP r2, #space-1 ; Finished ?
BHI %BT10
CMP r2, r2 ; return EQ (also GE)
MOV pc, lr
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Case-sensitive string comparison
; In r0, r1 -> strings - CtrlChar terminated (NB. Must be same CtrlChar !)
; Out flags set on (char *)(r0) - (char *)(r1)
hs_StringSensCMP ROUT
10 LDRB r2, [r0], #1
LDRB r3, [r1], #1
CMP r2, r3 ; Differ ?
MOVNE pc, lr ; GE or LT
CMP r2, #space-1 ; Finished ?
BHI %BT10
CMP r2, r2 ; return EQ (also GE)
MOV pc, lr
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
LTORG
END