; >FileCore32

; *********************************
; ***  CHANGE LIST AND HISTORY  ***
; *********************************
;
; 16-Jun-94   AMcC  Replaced ScratchSpaceSize with ?ScratchSpace
;

 [ NewFs

        TTL     "New map auto compact"

; ==============
; DefCompactZone
; ==============

DefCompactZone
        MOV     R2,#(1:SHL:UseScratchSpace) :OR: (1:SHL:UseSpareScreen) :OR: (1:SHL:UseWimpFree) :OR: (1:SHL:UseRmaHeap) :OR: (1:SHL:UseSysHeap) :OR: ScatterBit

; ===========
; CompactZone
; ===========

;entry
; R0  zone
; R1  >=0 space required, R1<0 do moves scoring <= -R1
; R2  option bits for FindBuffer
; R10 -> map start

;exit if error V set R0 -> error block

         ^ ScratchSpace  ;LAYOUT OF TABLES IN SCRATCH SPACE

IdHashLen       * 4*K
IdHash          # IdHashLen
;hash table for id half words of fragments adjacent to gap start
;bit 15 of half word set if matching second fragment found adjacent to gap

SizeLen         * 512           ;bit table of fragment adjacent to gap sizes
FragSize        # SizeLen       ;used to find fragments to fit gaps

MaxGaps         * 336
PreFrag         * 0     ;map offset of start of fragment before gap
PreId           * 4
PostLen         * 8
PostId          * 12
PostFrag        * 16    ;map offset of start of fragment after gap
GapOff          * 20    ;map offset of start of gap
JoinNext        * 24
GapEntrySz  * 28
GapFrags        # MaxGaps*GapEntrySz
;entry of 7 words for each gap, used to choose which fragment to move with
;eventual aim of causing two gaps to join
;IF JoinNext<=2 this gap can't be joined to next gap by moving fragments to
;earlier gap since it is either first/last gap or defects separate them

        ASSERT  @<= ScratchSpace + ?ScratchSpace

         ^ 0
MoveSource      # 4
MoveDest        # 4
MoveLen         # 4
MoveEntry       # 0

         ^ 0     ;stack workspace

MoveCtr         # 4
MoveLeft        # 4
MoveEndPtr      # 4

Moves           * 32
CompMovesSz     * Moves*MoveEntry

DummyMove       # MoveEntry
BestSource      * DummyMove     ;sharing
BestDest        * BestSource+4  ;workspace
CompMoves       # CompMovesSz

ScatMin         * ((ScatterMax*8-1)/MoveEntry)*MoveEntry
         # ScatMin       ;shift moves up by this to stop scatter list
                         ;overwriting them
CompZoneWork    # 0
CompZone        # 4     ;entry R0
SizeNeed        # 4     ;entry R1
CompClaimOpts   # 4     ;entry R2

CompactZone ROUT
        Push    "R0-R11,LR"
 [ DebugFx
        CheckBastardMap r1, "Map bad on entry CompactZone "
 ]
        BL      ZoneFlagsPtr    ;(R10->LR)
        LDRB    LR, [LR,R0]
        TSTS    LR, #ZoneCompacted
        BLNE    ClearV
        Pull    "R0-R11,PC",NE
 [ DebugF
        DREG    R0, "CompactZone(",cc
        DREG    R1, ",",cc
        DLINE   ")"
 ]

        SUB     SP, SP, #CompZoneWork-DummyMove
        BL      InitZoneFree    ;(R0,R10->R11)  LOOP TO TOTAL ZONE FREE SPACE
        MOV     R3, #0
05
        BL      NextFree        ;(R10,R11->R9,R11,Z,C)
        BLCC    RdLenBits       ;(R10,R11->R7)
        ADDCC   R3, R3, R7
        BCC     %BT05
        CMPS    R3, R1
        MOVLO   R1, R3

        MOV     R0, #0
        ADD     R2, SP, #MoveEntry
        ASSERT  MoveCtr=0
        ASSERT  MoveLeft=4
        ASSERT  MoveEndPtr=8
        ASSERT  DummyMove=12
        Push    "R0-R2"

10
;BUILD UP TABLES, REGISTER USAGE
;R0 temp                R4 previous offset      R8  id
;R1 temp                R5 previous id          R9  next space
;R2 log2 Alloc bit widthR6 -> gap table entry   R10 -> map start
;R3 next zone start bit R7 length               R11 map ptr

        MOV     R0, #IdHash      ;init hash tables
        ASSERT  FragSize=IdHash+IdHashLen
        MOV     R1, #SizeLen+IdHashLen
        BL      ZeroRam
        BL      Log2AllocBits   ;(R10->LR)
        MOV     R2, LR
        MOV     R6, #GapFrags
        ADD     R6, R6, #GapEntrySz
        LDR     R0, [SP,#CompZone]
        BL      InitZoneObj     ;(R0,R10->R8,R9,R11,LR)
        CMPS    R8, R9
        BEQ     %FT95           ;no gaps, V=0
        MOV     R3, LR
        MOV     R4, R11         ;init previous offset
        MOV     R5, #0          ;init previous id
        STR     R8, [R6,#GapOff-GapEntrySz]
12
        BL      RdLenLinkBits   ;(R10,R11->R7,R8)
        RSBS    LR, R8, #2      ;C=1 <=> id<=2
        TEQS    R9, R11         ;is this entry in map a gap
        STRHI   R8, [R6,#JoinNext-GapEntrySz] ;if prev gap cant join next
        MOVNE   R4, R11
        MOVNE   R5, R8
        BNE     %FT18           ;if not gap

        ADD     R9, R9, R8      ;next gap in zone if one exists

        CMPS    R5, #2          ;ENTER PRE GAP FRAGMENT IN ID HASH TABLE
        BLS     %FT14           ;if defect or out of zone
        ASSERT  IdHashLen=4*K
        BIC     R0, R5, #2*K*&7F
        ADD     R0, R0, #IdHash/2
        LDRB    R1, [R0,R0] !
        LDRB    LR, [R0,#1]
        ORR     R1, R1, LR, LSL #8      ;get id in hash table for this id
        TEQS    R5, R1                  ;IF same
        MOV     LR, R5
        ORREQ   LR, LR, #1 :SHL: 15     ; set match bit
        TSTNES  R1, #1 :SHL: 15         ;ELSE
        STREQB  LR, [R0]                ; IF NOT match enter this id in table
        MOVEQ   LR, LR, LSR #8
        STREQB  LR, [R0,#1]              ;ENDIF

        SUB     R0, R11, R4
        BL      %FT22           ;note fragment of that length (R0,R2)
14
        LDR     R0, [SP,#SizeNeed]
        SUBS    R0, R7, R0
        BLHI    MinMapObj       ;(R10->LR)
        CMPHIS  R0, LR
 [ DebugF :LAND: {FALSE}
        wrhex   R7, HS
        mess    HS,"gap big enough created",NL
 ]
        BHS     %FT94           ;no more to do if gap big enough
        Push    "R11"
        ADD     R11,R11,R7
        CMPS    R11,R3
        MOVHS   R7, #0
        MOVHS   R8, #1
        BLLO    RdLenLinkBits   ;(R10,R11->R7,R8)
        Pull    "LR"

        ASSERT  PreFrag=0          ;R4
        ASSERT  PreId=PreFrag+4    ;R5
        ASSERT  PostLen=PreId+4    ;R7
        ASSERT  PostId=PostLen+4   ;R8
        ASSERT  PostFrag=PostId+4  ;R11
        ASSERT  GapOff=PostFrag+4  ;LR
        STMIA   R6!,{R4,R5,R7,R8,R11,LR}
 [ DebugF :LAND: {FALSE}
        mess    ,"Pre Frag.Pre Id  .Post Len.Post Id .PostFrag.Gap Off",NL
        wrhex   R4
        wrhex   R5
        wrhex   R7
        wrhex   R8
        wrhex   R11
        wrhex   LR
        mess    ,NL
 ]
        ASSERT  JoinNext=24
        STR     R8, [R6],#4

        CMPS    R8, #2          ;ENTER POST GAP FRAGMENT IN ID HASH TABLE
        BLS     %FT16           ;if defect or out of zone
        ASSERT  IdHashLen=4*K
        BIC     R0, R8, #2*K*&7F
        ADD     R0, R0, #IdHash/2
        LDRB    R1, [R0,R0] !
        LDRB    LR, [R0,#1]
        ORR     R1, R1, LR,LSL #8 ;get id in hash table for this id
        TEQS    R8, R1
        MOV     LR, R8
        ORREQ   LR, LR, #1 :SHL: 15       ;if same set match bit
        STREQB  LR, [R0]
        MOVEQ   LR, LR, LSR #8
        STREQB  LR, [R0,#1]

        MOV     R0, R7
        BL      %FT22           ;note fragment of that length (R0,R2)
16
        MOV     R4, R11         ;update previous offset and id
        MOV     R5, R8
18
        ADD     R11,R11,R7
        CMPS    R11,R3
        BLO     %BT12
        MOV     LR, #1
        STR     LR, [R6,#JoinNext-GapEntrySz]   ;note last gap can't join next
        STR     LR, [R6,#PreFrag]               ;for FillGap

;NOW LOOK FOR FRAGMENTS OF SAME FILE THAT CAN BE JOINED, REGISTER USAGE
;R0                     R4 bits 15 & 31 set     R8
;R1                     R5 Id hash table        R9  old word after id table
;R2log2 alloc bit width R6 end gap table        R10 -> map start
;R3 id hash entry pair  R7                      R11 min map obj

        MOV     R5, #IdHash
        MOV     R4, #1 :SHL: 15
        ORR     R4, R4, #1 :SHL: 31
        MOV     LR, #IdHashLen
        LDR     R9, [R5,LR]             ;save word after Id hash table
        STR     R4, [R5,LR]             ;dummy end marker
        BL      MinMapObj               ;(R10->LR)
        MOV     R11,LR
20
        LDR     R3, [R5],#4
        TSTS    R3, R4
        BEQ     %BT20
        CMPS    R5, #IdHash+IdHashLen
        BHI     %FT38                   ;table exhausted
        TSTS    R3, #1 :SHL: 15
        BLNE    %FT24                   ;doesn't return if can do
        TSTS    R3, #1 :SHL: 31
        MOVNE   R3, R3, LSR #16
        BLNE    %FT24                   ;doesn't return if can do
        B       %BT20

22
        Push    "R0-R2,LR"       ;NOTE FRAG OF LENGTH R0 ADJACENT TO GAP
        MOV     R0, R0, LSR R2
        MOV     R1, #FragSize
        CMPS    R0, #SizeLen*8
        ADDLO   R1, R1, R0,LSR #3
        ANDLO   R2, R0, #7
        MOVLO   R0, #1
        LDRLOB  LR, [R1]
        ORRLO   LR, LR, R0, LSL R2
        STRLOB  LR, [R1]
        Pull    "R0-R2,PC",,^

; CHECK DETAILS FOR ID WHICH MAY ALLOW FRAGMENTS TO BE JOINED, REGISTER USAGE
;R0                     R4                      R8  2nd frags gap
;R1                     R5                      R9  gap length
;R2                     R6 end gap table        R10 -> map start
;R3 id                  R7 1st frag's gap       R11 min map obj

24
Stacked1 * 10*4
        Push    "R1-R5,R7-R9,R11,LR"
        MOV     R3, R3, LSL #17           ;mask to bottom 15 bits
        MOV     R3, R3, LSR #17
        MOV     R7, #GapFrags
26
        ADD     R7, R7, #GapEntrySz
        CMPS    R7, R6
        Pull    "R1-R5,R7-R9,R11,PC",HS,^ ;return from here when all checked
        LDR     LR, [R7,#PreId]
        TEQS    LR, R3
        BNE     %BT26
        LDR     R9, [R7,#GapOff]
        LDR     LR, [R7,#PostFrag]
        SUB     R9, LR, R9              ;gap length
        MOV     R8, R7
30
        LDR     LR, [R8,#PostId]
        TEQS    LR, R3
        ADDNE   R8, R8, #GapEntrySz
        BNE     %FT31

        LDR     R2, [R8,#PostLen]
        TEQS    R7, R8
        BNE     %FT32           ;If not same gap

        CMPS    R2, R9
        BLS     %FT34           ;IF frag <= gap then no need to split it

        MOV     R0, R2
        MOV     R1, R9
        BL      Divide          ;(R0,R1->R0,R1)
        MOV     R4, R0           ;gap DIV frag
        MOV     R5, R1           ;gap MOD frag

        MOV     R1, R0
        LDR     R0, [SP,#Stacked1+MoveCtr]
        BL      Divide          ;only continue if MoveCtr MOD (gap DIV frag)=0
        TEQS    R1, #0          ;to limit amount moved and map rewrites
        Pull    "R1-R5,R7-R9,R11,PC",NE,^

        CMPS    R5, #0          ;if no odd bit
        SUBNES  R0, R11,R5      ;or odd bit big enough to stand alone
        MOVLE   R2, R9          ;move a whole gap length
        BLE     %FT34

        MOV     R1, R4          ;otherwise reduce amount to move so that odd
        BL      Divide          ;bit could stand alone
        TEQS    R1, #0
        ADDNE   R0, R0, #1

        LDR     LR, [SP,#4]     ;log 2 alloc bit width
        MOV     R1, R0, LSR LR  ;round up adjust to multiple of alloc bit width
        TEQS    R1, R0, LSL LR
        ADDNE   R1, R1, #1
        MOVNE   R0, R1, LSL LR

        SUB     R2, R9, R0
        CMPS    R2, R11
        BLO     %BT26           ;give up if this failed as well
        B       %FT34

31
        CMPS    R8, R6
        BHS     %BT26
        LDR     LR, [R8,#PreId]
        TEQS    LR, R3
        BNE     %BT30
        LDR     R2, [R8,#PreFrag]
        LDR     R1, [R8,#GapOff]
        SUB     R1, R1, R2      ;fragment length
        SUBS    LR, R9, R1      ;amount spare in dest gap
        CMPHIS  LR, R11         ;if spare is it enough to form separate gap
        BLO     %BT26
; FOUND A PRE FRAG I CAN MOVE DOWN
        LDR     R3, [R8,#GapOff-GapEntrySz]
        B       %FT36

32
        SUBS    LR, R9, R2
        SUBMI   LR, R2, R9
        MOVMI   R2, R9
        CMPNES  LR, R11
        BLO     %BT26
34
; FOUND A POST FRAG I CAN MOVE DOWN
        MOV     R1, R2
        LDR     R2, [R8,#PostFrag]
        LDR     R3, [R8,#GapOff]
36
        LDR     R5, [R7,#GapOff]
        BL      CanMove         ;(R2,R5,R10->Z)
        BEQ     %BT26
 [ DebugF
        DLINE    "FMS:"
 ]
        LDR     R4, [R7,#PreFrag]
        ADD     SP, SP, #Stacked1
        MOV     R6, R5
        B       %FT80

38
        STR     R9, [R5,#-4]    ;restore word after Id hash table

; CONSIDER SINGLE EXACT, DOUBLE EXACT AND SINGLE INEXACT MOVES, REGISTER USAGE
;R0                     R4                      R8
;R1                     R5 best fit             R9  gap length
;R2 log2 alloc bit widthR6 end gap table        R10 -> map start
;R3                     R7 gap to fill or join  R11 min map obj
        MOV     R5, #-1         ;init best fit
        MOV     R7, #GapFrags
        B       %FT60
40
        LDR     R9, [R7,#GapOff]
 [ DebugF :LAND: {FALSE}
        wrhex   R5
        wrhex   R9
        mess    ,"CONSIDERING GAP",NL
 ]
        LDR     LR, [R7,#PostFrag]
        SUB     R9, LR, R9      ;gap length

        LDR     R0, [R7,#PreFrag+GapEntrySz]
        TEQS    R0, LR
        MOV     R1, #0
        BL      FillGap
        ORRNE   R1, R7, #1:SHL:31
        BLNE    FillGap
        MOV     R1, R7
        BL      FillGap

;NOW CONSIDER JOINING TWO GAPS MY MOVING SEPARATING FRAGMENTS

        LDR     LR, [R7,#JoinNext]
        CMPS    LR, #2
        LDRHI   R4, [R7,#GapOff+GapEntrySz]     ;start of next gap
        LDRHI   R3, [R7,#PostFrag]              ;end of this gap
        SUBHI   R1, R4, R3                      ;gap separation in map bits
        CMPHIS  R5, R1
        BLS     %FT60

        LDR     R8, [R7,#PreFrag+GapEntrySz]
        LDR     LR, [R7,#PostFrag+GapEntrySz]
        SUB     LR, LR, R4
        SUB     R4, R4, R8
        LDR     R0, [R7,#PostLen]

;                     this gap post frag   next gap pre frag
;frag size            R0                   R4
;size adjacent gap    R9                   LR
;map bit of frag      R3                   R8

        CMPS    R9, LR                   ;try fragment that would create larger
        Push    "R0,R3,R4,R8",LO        ;gap first
        Pull    "R4,R8",LO
        Pull    "R0,R3",LO
        BL      FindDest                ;->LO/HS
        Push    "R0,R3,R4,R8",HS        ;optionally try other fragment
        Pull    "R4,R8",HS
        Pull    "R0,R3",HS
        BLHS    FindDest

60
        ADD     R7, R7, #GapEntrySz
        CMPS    R7, R6
        BLO     %BT40
        LDR     LR, [SP,#SizeNeed]
        RSB     LR, LR, #0
        CMPS    R5, LR
        BLO     %FT78           ;found a good enough move
        BL      DefDoCompMoves  ;(R10,SP->R0,R3,R9,V) IF no move flush move buf
        BVS     %FT95
        CMPS    R5, #-1
        BLEQ    ZoneFlagsPtr    ;(R10->LR)            AND mark zone compacted
        LDREQ   R0, [SP,#CompZone]
        LDREQB  R1, [LR,R0]
        ORREQ   R1, R1, #ZoneCompacted
        STREQB  R1, [LR,R0]
        B       %FT95


78
        LDR     R3, [SP,#BestSource]
        LDR     R4, [SP,#BestDest]
 [ DebugF
        Push    "r0-r9"
        BIC     r3, r3, #1:SHL:31
        LDMIA   r3, {r0,r1,r4,r5,r6,r7,r8}
        DLINE   "OPre      ID       Gap      Post     ID       Join"
        DREG    r0,"S",cc
        DREG    r1," ",cc
        DREG    r7," ",cc
        DREG    r6," ",cc
        DREG    r5," ",cc
        DREG    r8," "
        BIC     r4, r4, #1:SHL:31
        LDMIA   r4, {r0,r1,r4,r5,r6,r7,r8}
        DREG    r0,"D",cc
        DREG    r1," ",cc
        DREG    r7," ",cc
        DREG    r6," ",cc
        DREG    r5," ",cc
        DREG    r8," "
        Pull    "r0-r9"
 ]
        TSTS    R3, #1 :SHL: 31
        BIC     R3, R3, #1 :SHL: 31
        LDREQ   R2, [R3,#PreFrag]
        LDREQ   R1, [R3,#GapOff]
        SUBEQ   R1, R1, R2
        LDRNE   R2, [R3,#PostFrag]
        LDRNE   R1, [R3,#PostLen]
        LDREQ   R7, [R3,#PreId]
        LDRNE   R7, [R3,#PostId]
        LDRNE   R3, [R3,#GapOff]
        LDREQ   R3, [R3,#GapOff-GapEntrySz]

        LDR     LR, [SP,#MoveLeft]      ;decrease half amount still willing to move
        SUB     LR, LR, R1, LSR #1      ;by half move size
        STR     LR, [SP,#MoveLeft]

        EOR     LR, R4, #1 :SHL: 31
        BIC     R4, R4, #1 :SHL: 31

        LDR     R6, [R4,#GapOff]
        LDR     R0, [R4,#PostFrag]
        TEQS    R0, R2
        MOV     R9, PC          ;note if source immediately after dest
        TEQS    LR, R4
        SUBEQ   R5, R0, R1
        MOVNE   R5, R6
        SUBNE   R8, R0, R6
        TEQNES  R8, R1          ;IF putting at end or exact fit
        TSTEQS  R9, #Z_bit      ;and next frag is not source
        LDREQ   R8, [R4,#PostId]
        TEQEQS  R8, R7          ;and id same as next
        LDREQ   R4, [R4,#PostLen]
        ADDEQ   R4, R0, R4
 [ DebugF :LAND: {FALSE}
        mess    EQ,"frag joins next",NL
 ]
        MOVNE   R4, R5

;HERE WHEN DECIDED WHICH FRAGMENT TO MOVE
; R1 length to move
; R2 map bit of frag to move
; R3 map bit of start of pre gap for source frag
; R5 map bit of dest
; R6 map bit of frag dest gap
; R4>R5 => post join
; R4=R5 => no join
; R4<R5 => pre join

80
 [ DebugF
        DREG    R1,"Mv:",cc
        DREG    R2," Fm:",cc
        DREG    R3," SG:",cc
        DREG    R4," Mrg:",cc
        DREG    R5," To:",cc
        DREG    R6," DG:"
 ]

;ENTER MOVE IN BUFFER, FLUSHING IF DEST WOULD OVERWRITE SOURCE OF BUFFERED MOVE
;AND CANCELLATION NOT POSSIBLE, REGISTER USAGE

;entry
;R1 new length
;R2 new source start
;R5 new dest start

;usage
;R3 move end ptr
;R4 old move
;R6 new source end
;R7 new dest end
;R8 old source start
;R9 old dest start
;LR old length

Stacked0 * 6*4
        Push    "R1-R6"
        LDR     R3,[SP,#Stacked0+MoveEndPtr]
 [ DebugF :LAND: {FALSE}
        wrhex   R3
        mess    ,"mov end ptr",NL
 ]
        SUB     R0,R3,SP
        CMPS    R0,#Stacked0+CompMoves+(MoveEntry*(Moves-4))
        BLE     %FT82
        ADD     R9,SP,#Stacked0+CompMoves
        BL      DoCompMoves     ;(R3,R9,R10->R3,R0,V)
        ADDVS   SP,SP,#Stacked0
        BVS     %FT95
82
        ADD     R0,SP,#Stacked0+CompMoves
        MOV     R9,#-1          ;init earliest old dest to overlap new source
        ADD     R6,R2,R1
        ADD     R7,R5,R1
        B       %FT88
84
        LDMIA   R0!,{R8,R11,LR} ;get old source, dest, length
 [ DebugF :LAND: {FALSE}
        wrhex   R8
        wrhex   R11
        wrhex   LR
        mess    ,"source dest len",NL
 ]
        CMPS    R8,R7           ;IF old source start >= new dest end
        ADD     R8,R8,LR
        CMPLOS  R5,R8           ;OR new dest start >= old source end
        SUB     R8,R8,LR
        BHS     %FT86           ;THEN new dest and old src dont overlap
                         ;will moves cancel at all ?
 [ DebugF :LAND: {FALSE}
        mess    ,"dest overlaps with a src",NL
 ]
        SUB     R8,R11,R8       ;ie is (dest-src)+(new dest-new src)=0
        ADD     R8,R8,R5
        SUBS    R8,R8,R2
 [ DebugF :LAND: {FALSE}
        mess    EQ,"but cancellation possible",NL
 ]
        BEQ     %FT86

        ADD     R9,SP,#Stacked0+CompMoves
        BL      DoCompMoves     ;(R3,R9,R10->R3,V) if not do bufferred moves
        ADDVS   SP,SP,#Stacked0
        BVS     %FT95
        B       %BT82          ;and start again

86
        CMPS    R11,R6          ;IF old dest start < new source end
        ADDLO   R8,R11,LR
        CMPLOS  R2,R8           ;AND new source start < old dest end
        CMPLOS  R11,R9          ;AND earliest dest to overlap
        MOVLO   R9,R11          ;then note it
        SUBLO   R4,R0,#MoveEntry
88
        CMPS    R0,R3           ;loop until all old moves examined
        BLO     %BT84

        CMPS    R9,#-1
        Push    "R1",EQ
        Push    "R2,R5",EQ
        BEQ     %FT90          ;no overlap

 [ DebugF :LAND: {FALSE}
        mess    ,"old dest overlaps new source",NL
 ]
        ASSERT  MoveSource=0
        ASSERT  MoveDest=4
        ASSERT  MoveLen=8
        LDMIA   R4,{R8,R9,LR}   ;get old move

        SUBS    R0,R2,R9        ;new source start - old dest start
        STRGT   R0,[R4,#MoveLen];IF > split old move at new source start
        ADDGT   R8,R8,R0
        ADDGT   R9,R9,R0
        SUBGT   LR,LR,R0
        MOVGT   R4,R3
        STMGTIA R3!,{R8,R9,LR}

        SUB     R11,R9,R2       ;IF < split new move at old source start
        Push    "R2,R5,R11"
        ADDLT   R2,R2,R11
        ADDLT   R5,R5,R11
        SUBLT   R1,R1,R11

        SUBS    R11,LR,R1               ;old len - new len
        STR     R5,[R4,#MoveDest]       ;give overlap new dest
        STRGT   R1,[R4,#MoveLen]        ;IF > split old at new dest end
        ADDGT   R0,R8,R1
        ADDGT   R9,R9,R1
        STMGTIA R3!,{R0,R9,R11}

        TEQS    R8,R5           ;IF old source start = new dest start
        LDMEQDB R3!,{R0,R6,R7}  ;THEN remove pointless move
        STMEQIA R4,{R0,R6,R7}
        CMPS    LR,R1

        ADDLT   R2,R2,LR
        ADDLT   R5,R5,LR
        SUBLT   R1,R1,LR
90
        Pull    "R6,R7,R8"       ;retrieve (start of) new move to add
        BL      AddMove          ;(R3,R6,R7,R8->R3)
        STR     R3,[SP,#Stacked0+MoveEndPtr]       ;put in end marker
 [ DebugF :LAND: {FALSE}
        wrhex   R3
        mess    ,"new move end ptr",NL
        mess    LT,"looping to check for further cancel",NL
 ]
        BLT     %BT82          ;loop if some of new move left which may cancel
        Pull    "R1-R6"

        BL      InvalidateFragCache     ;in case cached frag moving
        MOV     R11,R2
        BL      RdLenLinkBits   ;(R11->R7,R8)

        CMPS    R7, R1          ;split source fragment if necessary
        Push    "R1",HI
        MOVHI   R0, R1
        MOVHI   R1, R2
        BLHI    WrLenBits       ;(R0,R1,R10)
        ADDHI   R1, R1, R0
        MOVHI   R0, R8
        BLHI    WrLinkBits      ;(R0,R1,R10)
        Pull    "R1", HI

        MOV     R0, #0          ;return old space
        BL      ShortenFrag     ;(R0-R3,R10)

        SUBS    R0, R5, R6      ;IF dest not at start of gap
        MOVHI   R1, R6
        BLHI    WrLenBits       ; (R0,R1,R10) change gap length

        MOVHI   R0, R8
        MOVHI   R1, R5
        BLHI    WrLinkBits      ; (R0,R1,R10) and create frag at gap end
        BHI     %FT93

        MOV     R2, R8, LSL #8
        Push    "R4,R5"
        MOV     R4, R1
        LDRB    R0,[SP,#2*4+CompZone]
        BL      InitZoneFree    ;(R0,R10->R11)
        MOV     R0, R11
92
        BL      NextFree        ;(R10,R11->R9,R11,Z,C)
        CMPS    R11,R6
        MOVLO   R0, R11
        BLO     %BT92
        MOV     R6, R0
        BL      DefChainClaim   ;(R2,R4,R6,R10->R5,R11,LR)
        Pull    "R4,R5"
93
        SUBS    R0,R4,R5        ;join with next/previous fragment if requested
        MOVHI   R1,R5
        SUBLO   R0,R1,R0
        MOVLO   R1,R4
        BLNE    WrLenBits       ;(R0,R1,R10)

        LDR     LR,[SP,#MoveCtr]
        ADD     LR,LR,#1
        STR     LR,[SP,#MoveCtr]
        LDR     LR,[SP,#MoveLeft]
        MOVS    LR,LR
        BPL     %BT10           ;loop if willing to move more
94
        BL      DefDoCompMoves  ;(R10,SP->R0,R3,R9,V)
95
        ADD     SP,SP,#CompZoneWork
        STRVS   R0,[SP]
 [ DebugFx
        LDR     R1, [sp, #1*4]
        CheckBastardMap R1, "Compact zone fucked up:"
 ]
        Pull    "R0-R11,PC"



; =======
; AddMove
; =======

;entry
; R3 -> end of CompMoves list
; R6 source start
; R7 dest start
; R8 length (nothing to do if <=0)

;exit
; R3 updated

AddMove ROUT
Stacked0a * 8*4
        Push    "R0-R2,R4,R5,R9-R10,LR"
 [ DebugF :LAND: {FALSE}
        mess    ,"MovesEnd.Source  .Dest    .Length >Addmove",NL
        wrhex   R3
        wrhex   R6
        wrhex   R7
        wrhex   R8
        mess    ,NL
 ]
        CMPS    R8,#0
        BLE     %FT30           ;no move to add
        ADD     R0,SP,#Stacked0a+Stacked0+CompMoves
        MOV     R1,#0           ;init move that joins start of new move
        MOV     R2,R3           ;init move that joins end of new move
        ADD     R4,R6,R8        ;new source end
        ADD     R5,R7,R8        ;new dest end
        B       %FT20
10
        LDMIA   R0!,{R9,R10,LR};get old source, dest, length
        TEQS    R9,R4
        TEQEQS  R10,R5
        SUBEQ   R2,R0,#MoveEntry        ;note move if joins end
        ADDEQ   R8,R8,LR                ; and adjust length
        ADD     R9,R9,LR
        ADD     R10,R10,LR
        TEQS    R9,R6                   ;note move if joins start
        TEQEQS  R10,R7                  ; and adjust length
        SUBEQ   R1,R0,#MoveEntry
        ADDEQ   R8,R8,LR
20
        CMPS    R0,R3
        BLO     %BT10

        TEQS    R2,R3                   ;IF there was a move which joined end
        STMNEIA  R2,{R6-R8}             ; modify that move
        STMEQIA  R3!,{R6-R8}            ;ELSE add new move to list

        TEQS    R1,#0                   ;IF there was a move which joined start
        STRNE   R8,[R1,#MoveLen]        ; adjust its length
        LDMNEDB  R3!,{R9,R10,LR}        ; and remove other move
        STMNEIA  R2,{R9,R10,LR}
30
 [ DebugF :LAND: {FALSE}
        wrhex   R3
        mess    ,"<AddMove",NL
 ]
        Pull    "R0-R2,R4,R5,R9-R10,PC",,^


; =======
; CanMove
; =======

;return EQ <=> order of id conflicts in moving fragment at R2 to gap at R5
;in map starting at R10
;DOES NOT CONSIDER SIZE

CanMove ROUT
        Push    "R0,R2,R6-R9,R11,LR"
 [ DebugF :LAND: {FALSE}
        wrhex   R2
        wrhex   R5
        mess    ,">CanMove",NL
 ]
        MOV     R11,R2
        BL      RdLinkBits    ;(R10,R11->R8,Z)
        MOV     R6, R8
        CMPS    R2, R5
        MOVHI   R9, R5
        MOVHI   R11,R5
        BHI     %FT10           ;fragment after gap

        LDRB    LR, [R10,#ZoneHead+SectorSize]
        MOV     R0, R5, LSR LR
        MOV     R0, R0, LSR #3    ;zone
        BL      InitZoneFree    ;(R0,R10->R11)
05
        BL      RdLinkBits      ;(R10,R11->R8,Z)
        ADDNE   R11,R11,R8
        MOV     R9, R11
        CMPNES  R2, R11
        BHI     %BT05
        MOV     R11,R2
        BL      RdLenBits       ;(R10,R11->R7)
        ADD     R11,R11,R7
        MOV     R2, R5          ;gap
        B       %FT25
10
; R2  end of area to check
; R6  id must not find
; R9  next gap
; R11 start of area to check

        TEQS    R9, R11
        BNE     %FT15           ;not a gap
        BL      RdLinkBits      ;(R10,R11->R8,Z)
        ADD     R9, R11,R8      ;next gap, if it exists
        B       %FT20

15
        BL      RdLinkBits      ;(R10,R11->R8,Z)
        TEQS    R8, R6
        BEQ     %FT95
20
        BL      RdLenBits       ;(R10,R11->R7)
        ADD     R11,R11,R7
25
        CMPS    R11,R2          ;all checked ?
        BNE     %BT10
        TEQS    PC, #0          ;set NE if OK
95
 [ DebugF :LAND: {FALSE}
        mess    EQ,"Can't <CanMove",NL
        mess    NE,"Can <CanMove",NL
 ]
        Pull    "R0,R2,R6-R9,R11,PC"


; +++++++
; FillGap
; +++++++

;entry
; R1  0 => no extra move, + => also move pre frag, - => also move post frag
; R2  log2 alloc bits
; R5  best fit
; R6  end of GapFrags
; R7  gap to fill
; R9  gap length
; R10 -> map start
; R11 min map obj
; SP  -> Compact zone workspace

;exit R5 updated and R0,R3,R4,R8 corrupt

FillGap ROUT
Stacked2 * 2*4
        Push    "R9,LR"
 [ DebugF :LAND: {FALSE}
        wrhex   R1
        wrhex   R7
        wrhex   R9
        mess    ,">FillGap",NL
 ]
        CMPS    R1, #0

        MOVEQ   R4, #NIL        ;invalid id
        MOVEQ   R8, #0

        LDRLT   R4, [R7,#PostId]
        LDRLT   R8, [R7,#PostLen]

        LDRGT   R4, [R7,#PreId]
        LDRGT   R0, [R7,#PreFrag]
        LDRGT   R8, [R7,#GapOff]
        SUBGT   R8, R8, R0

        CMPS    R4, #2
        BLS     %FT95

        ADD     R9, R9, R8      ;size of gap once extra move done (may be
        LDR     LR, [SP,#Stacked2+SizeNeed]     ;bigger if pre gap joins)
        SUBS    LR, R9, LR
        CMPHIS  LR, R11
        CMPHSS  R5, LR
        MOVHI   R3, #NIL
        MOVHI   R4, #NIL
        MOVHI   R9, LR
        BHI     %FT22   ;if extended gap meets needs and best so far

        CMPS    R5, R9
        BLS     %FT95

;TRY SINGLE EXACT FIT
        MOV     R9, R9, LSR R2
        MOV     R0, R9, LSR #3
        ADD     LR, R0, #FragSize
        LDRB    LR, [LR]
        AND     R0, R9, #7
        MOV     LR, LR, LSR R0
        TSTS    LR, #1
        MOVNE   R0, R9, LSL R2
        BLNE    FindFrag        ;(R0,R4,R6,R7,R10->LR,Z)
        MOVNE   R3, LR
        MOVNE   R4, #NIL        ;invalid gap
 [ DebugF :LAND: {FALSE}
        wrhex   R1, NE
        wrhex   R3, NE
        mess    NE, "single exact fit",NL
 ]
        BNE     %FT20

;TRY DOUBLE EXACT FIT

        Push    "R1,R5,R8,R11"
        AND     R3, R9, #31
        BIC     R5, R9, #31
        MOV     LR, #FragSize
        ADD     R8, LR, R5, LSR #4
        SUB     R8, R8, #4        ;search end in FragSize
        ADD     R5, LR, R5, LSR #3
        LDR     R1, [R5]
        RSBS    LR, R3, #31
        MOVNE   R1, R1, LSL LR
        B        %FT15
;R1 word from FragSize table
;R3 bit within word examining
;R5 -> word containing bit for larger fragment
;R8 -> where to stop in FragSize
;R9 alloc units required
05
        TEQS    R1 ,#0
10
        LDREQ   R1, [R5,#-4] !
        MOVEQ   R3, #32
        TEQEQS  R5, R8
        BEQ     %FT90           ;all pairs tried
        SUB     R3, R3, #1
15
        MOVS    R1, R1, LSL #1
        BCC     %BT10           ;no fragment of this size
        ADD     R11,R3, R5, LSL #3
        RSB     R0, R11,#FragSize :SHL: (3+1)
        ADD     R0, R0, R9
        CMPS    R0, R11
        BHS     %FT90           ;tried all
        AND     LR, R0, #7
        MOV     R0, R0, LSR #3
        LDRB    R0, [R0]
        MOV     R0, R0, LSR LR
        TSTS    R0, #1

        SUBNE   R11,R11,#FragSize :SHL: 3
        MOVNE   R0, R11,LSL R2
        BLNE    FindFrag        ;(R0,R4,R6,R7,R10->LR,Z)
        MOVNE   R11,LR
        RSBNE   R0, R0, R9, LSL R2
        BLNE    FindFrag        ;(R0,R4,R6,R7,R10->LR,Z)
        BEQ     %BT05

        MOV     R3, LR          ;short source
        MOV     R4, R11         ;long source
        MOV     LR, R4, ROR #31
        CMPS    LR, R3, ROR #31
        MOVLO   R4, R3          ;swap if necessary to do earlier first
        MOVLO   R3, R11         ;to avoid id conflicts
        Pull    "R1,R5,R8,R11"

 [ DebugF :LAND: {FALSE}
        wrhex   R1
        wrhex   R3
        wrhex   R4
        mess    ,"double exact fit",NL
 ]
20
        CMPS    R1, #0
        STREQ   R3, [SP,#Stacked2+BestSource]
        STREQ   R7, [SP,#Stacked2+BestDest]
        ADDEQ   R5, R8, R9, LSL R2
        BEQ     %FT95           ;no extra move
        ADD     R9, R8, R9, LSL R2
22
        CMPS    R1, #0
;IF EXTRA MOVE FIND SMALLEST POSSIBLE GAP TO PUT IT IN
Stacked2a * 4*4
        Push    "R1,R2,R5,R9"
        LDRLT   R2, [R7,#PostFrag]
        LDRGT   R2, [R7,#PreFrag]
        MOV     R1, #GapFrags
        MOV     R9, #-1         ;init smallest gap for extra move
        B       %FT30
25
        TEQS    R1, R7
        TEQNES  R1, R3
        TEQNES  R1, R4
        BEQ     %FT30

        LDR     R5, [R1,#GapOff]
        LDR     R0, [R1,#PostFrag]
        SUB     R0, R0, R5      ;gap length
        SUBS    LR, R0, R8      ;IF gap < frag
        CMPHIS  LR, R11         ;OR gap left (if any) < min map obj
        CMPHSS  R9, R0          ;OR smallest <= gap
        BLS     %FT30           ;THEN next gap

        BL      CanMove         ;(R2,R5,R10->Z)
        MOVNE   R9, R0          ;if possible update smallest
        STRNE   R1, [SP,#Stacked2a+Stacked2+BestDest]
30
        ADD     R1, R1, #GapEntrySz
        CMPS    R1, R6
        BLO     %BT25           ;loop while more gaps
        CMPS    R9, #-1
        Pull    "R1,R2,R5,R9"
        STRNE   R1, [SP,#Stacked2+BestSource]
        MOVNE   R5, R9
        B        %FT95
90
        Pull    "R1,R5,R8,R11"
95
 [ DebugF :LAND: {FALSE}
        wrhex   R5
        mess    ,"<FillGap",NL
 ]
        Pull    "R9,PC",,^


; ========
; FindFrag
; ========

FindFrag ROUT
;Try to find frag to move to gap
; R0  frag len in map bits
; R4  forbidden id for frag or NIL
; R6  GapFrags end
; R7  -> gap entry in GapFrags
; R10 -> map start

;exit if possible Z=0, LR->gap adjacent to frag, bit 31 set if post gap frag
        Push    "R1-R3,R5,R8,R9,R11,LR"
 [ DebugF :LAND: {FALSE}
        wrhex   R0
        wrhex   R6
        wrhex   R7
        wrhex   R10
        mess    ,">FindFrag",NL
 ]
        MOV     R3, #0           ;init largest adjacent gap
        LDR     R5, [R7,#GapOff]
        MOV     R1, R6
10
        SUB     R1, R1, #GapEntrySz
        CMPS    R1 ,#GapFrags
        BLS     %FT30           ;all tried
        TEQS    R1, R7
        BEQ     %BT10

        LDR     LR, [R1,#PostLen]
        LDR     R9, [R1,#GapOff]
        TEQS    R0, LR
        BNE     %FT20

        LDR     R2, [R1,#PostFrag]
        LDR     LR, [R1,#PreFrag+GapEntrySz]
        TEQS    LR, R2
        LDREQ   LR, [R1,#PostFrag+GapEntrySz]
        SUBEQ   R11,LR, R9
        ORREQ   R11,R11,#1 :SHL: 31
        SUBNE   R11,R2, R9
        LDR     LR, [R1,#PostId]
        CMPS    LR, #2
        TEQHIS  LR, R4
        LDRHI   LR, [R7,#PreFrag]
        TEQHIS  LR, R2
        CMPHIS  R11,R3
        BLS     %FT20

        BL      CanMove         ;(R2,R5,R10->Z)
        ORRNE   R8, R1, #1 :SHL: 31
        MOVNE   R3, R11
20
        LDR     R2, [R1,#PreFrag]
        SUB     LR, R9, R2
        TEQS    R0, LR
        BNE     %BT10

        LDR     LR, [R1,#PreId]
        CMPS    LR, #2
        TEQHIS  LR, R4
        LDRHI   LR, [R7,#PostFrag]
        TEQHIS  LR, R2
        LDRHI   R11,[R1,#PostFrag]
        SUBHI   R11,R11,R9
        CMPHIS  R11,R3
        BLS     %BT10

        BLNE    CanMove         ;(R2,R5,R10->Z)
        MOVNE   R8, R1
        MOVNE   R3, R11
        B        %BT10
30
        CMPS    R3, #0
        MOV     LR ,R8
 [ DebugF :LAND: {FALSE}
        wrhex   LR, NE
        wrhex   R3, NE
        mess    ,"<FindFrag",NL
 ]
        Pull    "R1-R3,R5,R8,R9,R11,PC"


; ++++++++
; FindDest
; ++++++++

;entry
; R0 frag size
; R1 separation between gap and next gap
; R3 frag
; R6 GapFragsEnd
; R7 gap before frag
; R10 -> map start
; R11 min map obj

;exit HS <=> need to try other frag

FindDest ROUT
Stacked3 * 7*4
        Push    "R2-R5,R8,R9,LR"

        MOV     R2, R3
        MOV     R3, #-1         ;init smallest suitable previous gap
        MOV     R9, #GapFrags   ;init gap ptr
10
        ADD     R9, R9, #GapEntrySz
        CMPS    R9, R6
        BHS     %FT95           ;all gaps tried

        LDR     LR, [R9,#PreFrag]       ;dont try to move frag upwards in same gap as
        TEQS    LR, R2                  ;removing it would change dest gap
        BEQ     %BT10
        LDR     R5, [R9,#GapOff]
        LDR     R8, [R9,#PostFrag]
        TEQS    R2, R8
        SUB     R8, R8, R5      ;gap length
        MOV     R4, R8
        BNE     %FT20

        CMPS    R8, R1                  ;If gap <= separation only
        ORRLS   R4, R4, #1 :SHL: 30     ;move frag within gap as last resort
        CMPS    R8, R0
        B        %FT30
20
        SUBS    LR, R8, R0      ;IF gap smaller than frag
        CMPHIS  LR, R11         ; OR gap left (if any) < min map obj
30
        CMPHSS  R3, R4          ; OR smallest gap so far better
        BLS     %BT10           ;THEN not suitable

        ADD     LR, R9, #GapEntrySz     ;calculate size of post dest frag run
        CMPS    LR, R6                  ;special case last gap
        MOVHS   LR, #-1
        LDRLO   LR, [R9,#GapOff+GapEntrySz]
        LDRLO   R8, [R9,#PostFrag]
        SUBLO   LR, LR, R8

        SUB     R8, R9, #GapEntrySz     ;calculate size of pre dest frag run
        CMPS    R8, #GapFrags           ;special case first gap
        CMPHIS  R4, R0                  ;special case exact fit
        MOVLS   R8, #-1
        LDRHI   R8, [R9,#PostFrag-GapEntrySz]
        SUBHI   R8, R5, R8

 [ DebugF :LAND: {FALSE}
        wrhex   R9
        wrhex   R8
        wrhex   LR
        mess    ,"gap, pre run, post run",NL
 ]

        CMPS    R8, LR          ;move frag to end with larger frag run
        MOVHS   LR, R8
        MOVHS   R8, R9
        ORRLO   R8, R9, #1 :SHL: 31
        CMPS    R1, LR
        BHS     %BT10           ;next gap if neither frag run is big enough

        BL      CanMove         ;(R2,R5,R10->Z)
        BEQ     %BT10           ;not possible
        MOV     R3, R4          ;update smallest suitable gap
        LDR     LR, [R7,#PostFrag]
        TEQS    LR, R2
        ORREQ   LR, R7, #1 :SHL: 31     ;source gap and pre/post bit
        ADDNE   LR, R7, #GapEntrySz
        STR     LR, [SP,#Stacked3+BestSource]
        STR     R8, [SP,#Stacked3+BestDest]
        TEQS    R0, R4          ;exact fit as well ?
        STREQ   R0, [SP,#3*4]
        STRNE   R1, [SP,#3*4]   ;overwite stacked R5 best fit
 [ DebugF :LAND: {FALSE}
        wrhex   R0, EQ
        wrhex   R1, NE
        wrhex   LR
        wrhex   R8
        mess    ,"move frag to join gaps",NL
 ]
        B       %BT10
95
        CMPS    R3, #1:SHL:31   ;HS <=> try other move
        Pull    "R2-R5,R8,R9,PC"


; ==============
; DefDoCompMoves
; ==============

; can only call when no extra on stack

DefDoCompMoves
        LDR     R3, [SP,#MoveEndPtr]
        ADD     R9, SP, #CompMoves

 [ F    ;T = Simple, F = optimised

; ===========
; DoCompMoves
; ===========

; do list of moves built up by CompactZone then update map on disc

;entry
; R3  move end ptr
; R9  move start ptr
; R10 -> map start

;exit R3 -> empty list

DoCompMoves ROUT
        Push    "R0-R2,R4-R10,R11,LR"
 [ DebugF ; :LAND: {FALSE}
        DREG   R3," ",cc
        DREG   R9," ",cc
        DREG   R10," ",cc
        DLINE  ">DoCompMoves"
 ]
        CMPS    R3, R9
        BLS     %FT95

        MOV     R6, R3
        ADD     R11,R9,#MoveEntry
        MOV     R0, #0
        STR     R0, [R9,#-MoveEntry]
        B       %FT10
00                              ;INSERTION SORT MOVES INTO ASCENDING
        SUB     R7, R11,#MoveEntry      ;SOURCE ORDER
05
        LDMDB   R7, {R3-R5}             ;pick up previous entry
        CMPS    R3, R0                  ;IF later
        STMHSIA  R7,{R3-R5}             ; move up previous entry
        SUBHS   R7, R7, #MoveEntry
        BHS     %BT05                   ; loop until earlier entry found
        STMIA   R7, {R0-R2}             ;put entry in correct place
10
        CMPS    R11,R6
        LDMLOIA  R11!,{R0-R2}           ;pick up entry
        BNE     %BT00                   ;loop until table end

                         ;CONVERT TO REAL DISC ADDRESSES AND LENGTHS
        LDR     R1, [R10,#ZoneHead+BitSize]
        MOV     R2, #0           ;init total move length
        LDR     R3, CritDiscRec
        LDR     R3, [R3,#RootDir]
        MOV     R4, R9
15
        LDR     R11,[R4,#MoveDest]
        BL      MapPtrToDiscAdd ;(R3,R10,R11->R0)
        MOV     R5, R0
        LDR     R11,[R4,#MoveSource]
        BL      MapPtrToDiscAdd ;(R3,R10,R11->R0)
        LDR     LR, [R4,#MoveLen]
        MOV     LR, LR, LSL R1    ;move length in bytes
        ADD     R2, R2, LR
 [ DebugF ; :LAND: {FALSE}
        DREG   R0," ",cc
        DREG   R5," ",cc
        DREG   LR," ",cc
        DLINE   "source dest len"
 ]
        STMIA   R4!,{R0,R5,LR}
        CMPS    R4, R6
        BLO     %BT15

        LDRB    R0, [R9,#CompClaimOpts-CompMoves]
        MOV     LR, #1
        LDRB    R3, [R10,#ZoneHead+SectorSize]
        MOV     R3, LR,LSL R3
        MOV     R1, R3
        BL      FindBuffer      ;(R0-R3->R0-R3,V)
        BVS     %FT95
        MOV     R5, R2          ;buffer size

20
        LDMDB   R6, {R0-R2}     ;pick up last move
 [ DebugF
	
	DREG	R0, "Move was (src, dest, len):(",cc
	DREG	R1, ", ",cc
	DREG	R2, ", ",cc
	DLINE	")"
 ]
        SUBS    LR, R2, R5      ;if move exceeds buffer then split it
 [ DebugF ; :LAND: {FALSE}
	BLE	%FT21
        DLINE	"splitting last move"
21
 ]


 [ BigDisc					; we need to account for sector size

	BLE     %FT22
        STR     LR, [R6,#MoveLen-MoveEntry]	; adjust prev move length
	Push	"R3"
	LDRB	R3, [R10,#ZoneHead+SectorSize]	; get sector size
   [ DebugF
	
	DREG	R3, "Sector size"
   ]
        ADD   	R0, R0, LR, LSR R3		; bump addrs, accounting for sector size
        ADD   	R1, R1, LR, LSR R3
        MOV     R2, R5
        STMIA   R6!,{R0-R2}			; store new move
	Pull	"R3"
22

 |

        STRGT   LR, [R6,#MoveLen-MoveEntry]	; adjust prev move length
        ADDGT   R0, R0, LR
        ADDGT   R1, R1, LR
        MOVGT   R2, R5
        STMGTIA  R6!,{R0-R2}
 ]

 [ DebugF
	
	DREG	R0, "Move replaced as (src, dest, len):(",cc
	DREG	R1, ", ",cc
	DREG	R2, ", ",cc
	DLINE	")"
 ]

        MOV     R0, R5
        MOV     R7, R6
25                              ;Find moves that can fit in buffer
        SUB     R7, R7, #MoveEntry
        CMPS    R7, R9
        LDRGE   LR, [R7,#MoveLen]
        SUBGES  R0, R0, LR
        BGE     %BT25
        ADD     R7, R7, #MoveEntry
        MOV     R8, R7
        BL      InitScatter
        sbaddr  R3, ScatterList
        MOV     R11,#0          ;init offset in buffer
 [ DebugF ; :LAND: {FALSE}
        DLINE "read move sources into buffer"
 ]
30                      ;READ MOVE SOURCES INTO BUFFER SPOTTING IF CONTIGUOUS
        LDR     R2, [R8,#MoveSource]
        MOV     R4, #0
35
        LDMIA   R8, {R0,R1,LR}
 [ BigDisc
	Push	"R5"

	LDRB	R5, [R10,#ZoneHead+SectorSize]
        ADD     R1, R2, R4, LSR R5

   [ DebugF
	
	DREG	R5, "Sector size : "
	DREG	R0, "Source addr : "
	DREG	LR, "Length : "
	DREG	R1, "Compare addr : "
	DREG	R0, "Prev end addr : "
   ]
	Pull	"R5"
 |
        ADD     R1, R2, R4
 ]
        TEQS    R1, R0
        BNE     %FT40

   [ DebugF
	DLINE	"Contiguous"
   ]

        STR     R11,[R8,#MoveSource]    ;replace src address by buffer offset
 [ DebugF
	DREG	R11, "Buffer offset : "
 ]
        ADD     R4, R4, LR      ;adjust move total
        ADD     R11,R11,LR      ;adjust buffer offset
        ADD     R8, R8, #MoveEntry
        CMPS    R8, R6
        BLO     %BT35
40
        MOV     R1, #ReadSecsOp :OR: ScatterBit :OR: Atomic
        BL      DoDiscOp        ;(R1-R4->R0,R2-R4,V)
        BVS     %FT90
        CMPS    R8, R6
        BLO     %BT30           ;loop while more sources to read into buffer

        MOV     R0, R7          ;shift moves up enough to stop scatter list
        ADD     R1, R0, #ScatMin;overwriting them
        SUB     R2, R6, R7
        BL      BlockMove

        ADD     R11,R7, #ScatMin
        ADD     R6, R6, #ScatMin

                         ;INSERTION SORT DESTINATION MOVES
        MOV     R0, #0           ;dummy dest entry
        STR     R0, [R11,#MoveDest-MoveEntry]
        ADD     R8, R11,#MoveEntry
 [ BigDisc
	Push	"R10"
 ]
        B       %FT55
45
        SUB     R10,R8,#MoveEntry
50
        LDMDB   R10,{R3,R4,LR}          ;pick up previous entry
        CMPS    R4, R1                  ;IF later
        STMHSIA  R10,{R3,R4,LR}         ; move up previous entry
        SUBHS   R10,R10,#MoveEntry
        BHS     %BT50                   ; loop until earlier entry found
        STMIA   R10,{R0-R2}             ;put entry in correct place
55
        CMPS    R8, R6
        LDMLOIA  R8!,{R0-R2}            ;pick up entry
        BLO     %BT45                   ;loop if more
 [ BigDisc
	Pull	"R10"
 ]
 [ DebugF ; :LAND: {FALSE}
        DLINE "write moves from buffer to dests"
 ]
60                              ;EMPTY BUFFER SPOTTING CONTIGUOUS ON DISC
        MOV     R3, R7          ;init ptr to scatter list
        MOV     R4, #0          ;init length
 [ DebugF
	
	DLINE   "60: LDR     R2, [R11,#MoveDest]"
 ]
        LDR     R2, [R11,#MoveDest]
65
 [ DebugF
	
	DLINE "65: LDMIA R11,{R1,R8,LR}"
 ]
        LDMIA   R11,{R1,R8,LR}  ;pick up buffer offset, dest, length
 [ BigDisc
	Push	"R5"
   [ DebugF
	DLINE	"Getting sector size"
   ]
	LDRB	R5,[R10,#ZoneHead+SectorSize]
        ADD     R0, R2, R4, LSR R5
	Pull	"R5"
 |
        ADD     R0, R2, R4
 ]
        TEQS    R8, R0
        BNE     %FT80           ;if not contiguous on disc leave for later

        ADD     R4, R4, LR
        sbaddr  R8, ScatterCopy
 [ DebugF
	DLINE	"Looping to find buffer chunk"
 ]
 [ BigDisc
	Push	"R10"
 ]
70                              ;loop to find buffer chunk containing start
        LDMIA   R8!,{R0,R10}    ;pick up (address,length) pair
        SUBS    R1, R1, R10
        BPL     %BT70
        ADD     R1, R1, R10
        ADD     R0, R0, R1      ;skip any unused start of buffer chunk
        SUB     R10,R10,R1
 [ DebugF
	DLINE	"Looping to construct scatter list"
 ]
75
        CMPS    R10,LR          ;IF this buffer fragment does not contain end
        STMLOIA  R3!,{R0,R10}   ; add whole buffer chunk to scatter list
        SUBLO   LR, LR, R10     ; decrease length left to find
        LDMLOIA  R8!,{R0,R10}   ; and loop for next buffer chunk
        BLO     %BT75           ;ELSE
        STMIA   R3!,{R0,LR}     ; add partial buffer chunk to list
 [ BigDisc
	Pull	"R10"
 ]

        ADD     R11,R11,#MoveEntry
        CMPS    R11,R6
        BLO     %BT65
80
 [ DebugF
	DLINE	"Doing the write DiscOp"
 ]
        MOV     R1, #WriteSecsOp :OR: ScatterBit :OR: Atomic
        MOV     R3, R7
        BL      DoDiscOp        ;(R1-R4->R0,R2-R4,V)
        BVS     %FT90

 [ DebugF
	
	DLINE	"End of write loop"
 ]

        CMPS    R11,R6
        BLO     %BT60           ;loop if more to write out of buffer

 [ DebugF
	
	DLINE	"End of overall loop"
 ]

        MOV     R6, R7
        CMPS    R7, R9
        BHI     %BT20           ;loop if more to read into buffer

 [ DebugF
	
	DLINE	"Writing free space map"
 ]

        BL      WriteFsMap      ;(->R0,V)
        MOV     R3, R6
90
 [ DebugF
	
	DLINE	"Returning buffer"
 ]
        BL      ReturnBuffer
95
        STRVS   R0, [SP]
 [ DebugF; :LAND: {FALSE}
	BVC	%FT96
        DREG    R0," ", cc
96
        DREG    R3, " ",cc
        DLINE   "<DoCompMoves"
 ]
        Pull    "R0-R2,R4-R11,PC"

 |

; ===========
; DoCompMoves
; ===========

; do list of moves built up by CompactZone then update map on disc

;entry
; R3  move end ptr
; R9  move start ptr
; R10 -> map start

;exit R3 -> empty list

DoCompMoves ROUT
        Push    "R0-R2,R4-R10,R11,LR"
 [ DebugF :LAND: {FALSE}
        wrhex   R3
        wrhex   R9
        wrhex   R10
        mess    ,">DoCompMoves",NL
 ]

 [ Debug

	DLINE	"********* DoCompMoves ***********"
	
 ]
        CMPS    R3, R9		; check for nothing to do
        BLS     %FT95		; and if nothing to do then do nothing

        MOV     R6, R3

                         ;CONVERT TO REAL DISC ADDRESSES AND LENGTHS

; Disc addresses are sector numbers with BigDisc.  DoCompMoves
; stores the group number for a move in the bottom 8 bits of the
; move address - which was previously OK as the addresses were
; always sector aligned so making the convention of storing
; the group number in those bits valid.  This will fail with
; the new disc address format, so we take advantage of the
; fact that we are always doing moves within a single zone.
; Thus we can convert disc addresses into a zone base address
; and offset - we then have a single, common base address for
; all moves which we store in workspace.  We then store just
; the byte offset into the zone - with the assumption that a
; zone is never more than 2G bytes in size.  The use of the
; byte offset instead of a sector offset also simplifies the
; other changes that are required.

        LDR     R1, [R10,#ZoneHead+BitSize]
        MOV     R2, #0           ;init total move length
        LDR     R3, CritDiscRec
        LDR     R3, [R3,#RootDir]
        MOV     R4, R9

; get the zone base address from the first move, and squirrel
; it away.  Also place it in a spare register to help with
; generation of offsets.

 [ BigDisc
	LDR	R11,[R4,#MoveDest]	; get a move address
	BL	MapPtrToZoneBase	; get base address of zone
	ADR	LR, DoCompZoneBase	;
	STR	R0, [LR]		; shove the value away
	MOV	R8, R0			; keep copy of zone base for arithmetic
; get sector size into R7
	MOV	R7, R3, LSR #29
	DiscRecPtr R7,R7
	LDRB	R7, [R7, #SectorSize]
 ]

02
        LDR     R11,[R4,#MoveDest]
        BL      MapPtrToDiscAdd ;(R3,R10,R11->R0)
 [ BigDisc
	SUB	R5, R0, R8	;get offset from zone base
	MOV	R5, R5, LSL R7	;convert to byte offset
 |
        MOV     R5, R0
 ]
        LDR     R11,[R4,#MoveSource]
        BL      MapPtrToDiscAdd ;(R3,R10,R11->R0)
 [ BigDisc
	SUB	R0, R0, R8	;offset address
	MOV	R0, R0, LSL R7	;in bytes
 ]
        LDR     LR, [R4,#MoveLen]
        MOV     LR, LR, LSL R1    ;move length in bytes
        ADD     R2, R2, LR        ;add to total move length
 [ DebugF :LAND: {FALSE}
        wrhex   R0
        wrhex   R5
        wrhex   LR
        mess    ,"source dest len",NL
 ]
        STMIA   R4!,{R0,R5,LR}
        CMPS    R4, R6
        BLO     %BT02

; get some buffer space

        LDRB    R0, [R9,#CompClaimOpts-CompMoves]
        MOV     LR, #1
        LDRB    R3, [R10,#ZoneHead+SectorSize]
        MOV     R3, LR,LSL R3
        MOV     R1, R3
        BL      FindBuffer      ;(R0-R3->R0-R3,V)
        BVS     %FT95
        MOV     R11, R2          ;buffer size

NewSrc          RN 2
NewDest         RN 3
NewLen          RN 4
SrcStart        RN 5
SrcEnd          RN 6
DestStart       RN 7
DestEnd         RN 8
First           RN 9
Chosen          RN 10
Free            RN 11

;INITIALISATION FOR CHOOSING GROUPS OF MOVES

        MOV     R0, #ScratchSpace+?ScratchSpace
        ADD     R7, First, #(Moves-1)*MoveEntry
 [ BigDisc
	MVN	R8, #0
	BIC	R8, R8, #&FF
	STMDB	R0, {R8-R10}	;dummy first group, source -ve offset
 |
        LDR     R8, [First]
        AND     R8, R8, #DiscBits
        STMDB   R0!,{R8-R10}    ;dummy first group, source end = disc start
 ]
                ^ 0,SP
SourceBest      # 4
DestBest        # 4
LenBest         # 4
BestMove        # 4
BestFit         # 4

GroupPtr        # 4
LastMove        # 4
MovesEnd        # 4
GroupNum        # 4
FirstMove       # 4
DoCompBufSize   # 4
        Push    "R0,R6-R9,R11"
        SUB     SP, SP, #5*4
        MOV     Chosen, R6

04
;CHOOSE MOVE MAXIMISING (SOURCE END - DEST START) TO START NEW GROUP
        MOV     R0, First
        MOV     R1, #bit31      ;max negative
06
        LDMIA   R0!,{NewSrc,NewDest,NewLen}
        ADD     LR, NewSrc, NewLen
        SUB     LR, LR, NewDest
        CMPS    LR, R1
        MOVGT   R1, LR
        SUBGT   R6, R0, #MoveEntry
        CMPS    R0, Chosen
        BLO     %BT06

        LDMIA   R6, {SrcStart,DestStart,R8}     ;swap chosen to end of ungrouped moves
        LDMDB   Chosen, {NewSrc,NewDest,NewLen}
        STMIA   R6, {NewSrc,NewDest,NewLen}
        LDRB    R6, GroupNum                    ;count another group
        ADD     R6, R6, #1
        STRB    R6, GroupNum


        ORR     NewSrc, SrcStart, R6		; eek! eek! eek! and eek!
 [ DebugF :LAND: {FALSE}
        wrhex   NewSrc
        wrhex   DestStart
        wrhex   R8
        mess    ,"move to start new group",NL
 ]
        STMDB   Chosen!,{NewSrc,DestStart,R8}
        SUBS    Free, Free, R8
        BHI     %FT10                           ; move shorter than buffer
        BEQ     %FT08                           ; move same length as buffer

;CHOSEN MOVE IS BIGGER THAN BUFFER SO SPLIT IF DESIRABLE AND POSSIBLE
        MOV     R0, R8
        ADD     R1, Free, R8
        BL      Divide
        TEQS    R1, #0
08
        ADD     Free, Free, R8
        ADD     R0, SP, #:INDEX: GroupPtr
        ASSERT  LastMove - GroupPtr =4
        ASSERT  MovesEnd - LastMove =4
        LDMIA   R0, {R0,R4,LR}

        ADD     R3, SrcStart, R8
        SUB     R3, R3, Free
        STR     R3, [R0,#-12]!
 [ DebugF :LAND: {FALSE}
        wrhex   R3
 ]
        ADDEQ   NewDest, DestStart, Free
        ADDNE   NewDest, DestStart, R1
        STMIB   R0, {NewDest,R6}
        TEQNES  R4, LR
 [ DebugF :LAND: {FALSE}
        wrhex   R3, EQ
        ADDNE   LR, NewDest, Free
        wrhex   LR, NE
        wrhex   R6
        mess    ,"start end group - split",NL
 ]
        STR     R0, GroupPtr
        BEQ     %FT28           ;if move is an exact number of buffer lengths

 [ DebugF :LAND: {FALSE}
        mess    ,"can and want to split",NL
 ]
        ADD     LR, NewDest, Free
        STR     LR, [R0,#4]
        ADD     R6, R6, #1      ;count another group for remaining fragment
        STRB    R6, GroupNum
        STRB    R6, [Chosen]
        STR     R1, [Chosen,#2*4]
        SUB     R8, R8, R1      ;length of move - odd bit
        ADD     NewSrc, NewSrc, R1
        STMIA   R4!,{NewSrc, NewDest, R8}
        STR     R4, LastMove
        SUB     Free, Free, R1
        MOV     R8, R1
10
;LOOK FOR MOVE THAN MINIMISES EXTRA SEEKING TO ADD TO GROUP
        ADD     SrcEnd, SrcStart, R8
        ADD     DestEnd, DestStart, R8

12
        MOV     R0, #bit30      ;Large +ve
        STR     R0, BestFit
14
        CMPS    First, Chosen
        BHS     %FT24
        LDMIA   First!, {NewSrc,NewDest,NewLen}
 [ DebugF :LAND: {FALSE}
        wrhex   NewSrc
        wrhex   NewDest
        wrhex   NewLen
        mess    ,"move considering for group",NL
 ]
        CMPS    NewLen, Free
        BLS     %FT16
        LDR     R1, DoCompBufSize
        CMPS    NewLen, R1
        BLS     %BT14

        ASSERT  MovesEnd-LastMove=4
        ADD     R0, SP, #:INDEX:LastMove
        LDMIA   R0,{R0,LR}
        CMPS    R0, LR
        BHS     %BT14           ;no room to split move

        MOV     R0, NewLen
        BL      Divide          ;(R0,R1->R0,R1)
        CMPS    Free, R1        ;only consider splitting if 0 < odd bit <= free
        CMPHSS  R1, #0
        BLS     %BT14

        SUB     NewLen, NewLen, Free
        ADD     NewSrc, NewSrc, NewLen
        ADD     NewDest, NewDest, NewLen
        MOV     NewLen, Free
16
        SUBS    R0, DestStart, NewDest
        SUBHI   R0, R0, NewLen
        MOVHI   R1, NewDest
        BHI     %FT18
        SUBS    R0, NewDest, DestEnd
        RSBLO   R0, NewLen, #0
        MOV     R1, DestStart
18
        SUBS    LR, NewSrc,SrcEnd
        BLO     %FT20
        ADD     R0, R0, LR
        SUB     R1, NewSrc, R1
        ADDS    R1, R1, NewLen
        RSBMI   R1, R1, #0
        ADD     R0, R0, R1
        B       %FT22
20
        SUBS    R1, SrcEnd, R1
        RSBMI   R1, R1, #0
        ADD     R0, R0, R1
        SUBS    R1, SrcStart, NewSrc
        SUBHI   R1, R1, NewLen
        RSBLS   R1, NewLen, #0
        ADD     R0, R0, R1
22
        SUBS    R1, SrcEnd, DestStart
        RSBMI   R1, R1, #0
        SUB     LR, R0, R1
        LDR     R0, BestFit
        CMPS    LR, R0
        BGE     %BT14
        ADD     R1, NewSrc, NewLen
        SUBS    R1, R1, NewDest
        RSBMI   R1, R1, #0
        SUBS    R0, SrcEnd, DestStart
        SUBMI   R0, DestStart, SrcEnd
        ADD     R0, R0, R1
        CMPS    LR, R0
 [ DebugF :LAND: {FALSE}
        wrhex   NewSrc,LE
        wrhex   NewDest,LE
        wrhex   NewLen,LE
        wrhex   LR,LE
        mess    LE,"better move to add to group",NL
 ]
        STMLEIA  SP,{NewSrc,NewDest,NewLen,First,LR}
        B       %BT14

24
        LDMIA   SP, {NewSrc,NewDest,NewLen,First,LR}
        TEQS    LR, #bit30
        BEQ     %FT27

        LDR     LR, [First,#-4]
        SUBS    LR, LR, NewLen
        BLS     %FT26

        STR     LR, [First,#-4]
        MOV     R0, First
        ADD     R1, R0, #MoveEntry
        ASSERT  NewSrc=R2
        LDR     R2, LastMove
        ADD     R2, R2, #MoveEntry
        STR     R2, LastMove
        SUB     R2, R2, R0
        BL      BlockMove
        ADD     First, First, #MoveEntry
        ADD     Chosen, Chosen, #MoveEntry
        LDR     NewSrc,SourceBest
26
        CMPS    NewSrc, SrcStart
        MOVLO   SrcStart, NewSrc
        ADD     R0, NewSrc, NewLen
        CMPS    R0, SrcEnd
        MOVHI   SrcEnd, R0

        CMPS    NewDest, DestStart
        MOVLO   DestStart, NewDest
        ADD     R0, NewDest, NewLen
        CMPS    R0, DestEnd
        MOVHI   DestEnd, R0

        LDMDB   Chosen, {R0,R1,LR}
        STMDB   First, {R0,R1,LR}
        LDRB    R0, GroupNum
        ORR     R0, R0, NewSrc
 [ DebugF :LAND: {FALSE}
        wrhex   R0
        wrhex   NewDest
        wrhex   NewLen
        mess    ,"add move to group",NL
 ]
        STMDB   Chosen!,{R0,NewDest,NewLen}

        SUBS    Free, Free, NewLen
        LDRNE   First, FirstMove
        BNE     %BT12
27
        LDR     R0, GroupPtr
        LDRB    LR, GroupNum
 [ DebugF :LAND: {FALSE}
        wrhex   SrcStart
        wrhex   SrcEnd
        wrhex   DestStart
        wrhex   DestEnd
        wrhex   LR
        mess    ,"group completed ",NL
 ]
        STMDB   R0!,{SrcStart,DestEnd,LR}
        STR     R0, GroupPtr

        ASSERT  DoCompBufSize = FirstMove +4
        ADD     First, SP, #:INDEX: FirstMove
        LDMIA   First, {First,Free}
28
        CMPS    First, Chosen
        BLO     %BT04

;NOW OPTIMISE ORDER OF GROUPS

        LDR     R4, [SP,#5*4] !
 [ BigDisc
	MVN	LR,#0
	BIC	LR, LR, #&FF
	STR	LR, [R4,#-8]		;dest for dummy last group
 |
        LDR     LR, [First]
        AND     LR, LR, #DiscBits
        STR     LR, [R4,#-8]            ;dest for dummy last group
 ]
        MOV     R0, R4
        ASSERT  ScratchSpace>256
        MOVS    R1, #ScratchSpace+?ScratchSpace      ;also C=0 ie LO
        BL      %FT35
        MOV     R1, #bit30
        B       %FT34

30
        MOV     R1, R5
        MOV     R0, #ScratchSpace+?ScratchSpace
        SUB     R0, R0, #3*4
        LDMIA   R11,{R6,R7}
        MOV     R3, #NIL
31
        TEQS    R0, R11
        LDMDA   R0!,{R8-R10}
        TEQNES  R0, R11
        BEQ     %FT32
        SUBS    R9, R8, R10
        SUBMI   R9, R10,R8
        SUBS    R8, R8, R6
        RSBMI   R8, R8, #0
        SUBS    R10,R10,R7
        RSBMI   R10,R10,#0
        ADD     R8, R8, R10
        SUB     R8, R8, R9
        CMPS    R5, R8, ASR #8
        MOVGT   R5, R8, ASR #8
        ADDGT   R3, R0, #3*4
32
        CMPS    R0, R4
        BHS     %BT31

        TEQS    R3, #NIL
        BEQ     %FT34
        LDR     R8, [R11,#2*4]
        SUBS    R2, R11,R3
        MOVHI   R0, R3
        ADDHI   R1, R0, #3*4
        ADDLO   R0, R11,#3*4
        MOVLO   R1, R11
        SUBLO   R2, R3, R0
        BLNE    BlockMove
        STMHIIA  R3,{R6-R8}
        STMLODB  R3,{R6-R8}
        SUB     R0, R11,#3*4
        ADD     R1, R0, #2*3*4
        BL      %FT35           ;corrupts R2,R5-R10
        SUB     R0, R3, #2*3*4
        ADD     R1, R0, #3*3*4
        BL      %FT35
        MOV     R1, #bit30

34
        ADD     R0, R4, #2*4
        MOV     R5, #bit31
        B       %FT37

35
        ADDHI   R0, R0, #3*4
        ADDHI   R1, R1, #3*4
        CMPS    R1, #ScratchSpace+?ScratchSpace
        SUBHS   R1, R1, #3*4
38
        LDMDA   R1!,{R5-R10}
        SUBS    R6, R5, R7
        SUBMI   R6, R7, R5
        SUBS    R2, R8, R10
        SUBMI   R2, R10,R8
        ADD     R6, R6, R2
        SUBS    R2, R5, R10
        SUBMI   R2, R10,R5
        SUB     R6, R6, R2
        AND     R9, R9, #&FF
        ORR     R9, R9, R6
        STR     R9, [R1,#5*4]
        ADD     R1, R1, #3*4
        CMPS    R1, R0
        CMPHIS  R1, R4
        BHI     %BT38
        MOVS    PC, LR

36
        RSBS    LR, R5, R3, ASR #8
        CMPGTS  R1, R3, ASR #8
        MOVGT   R5, R3, ASR #8
        SUBGT   R11, R0, #5*4
37
        LDR     R3, [R0], #3*4
        CMPS    R0, #ScratchSpace+?ScratchSpace
        BLO     %BT36
        TEQS    R5, #bit31
        BNE     %BT30
        Pull    "R4,R6-R9"

; NOW RE-ORDER MOVES INTO NEW GROUP ORDER

        Push    "R6"
        MOV     R1, R6
        ADD     R4, R4, #8
40
        LDRB    R0, [R4],#MoveEntry
 [ DebugF :LAND: {FALSE}
        wrhex   R0
        mess    ,"GROUP",NL
 ]
        MOV     R0, R0, LSL #24
        MOV     R2, R1
42
        CMPS    R2, R9
        BLS     %FT46
        LDMDB   R2!,{R3,R5,R7}
        TEQS    R0, R3, LSL #24
        BNE     %BT42
 [ DebugF :LAND: {FALSE}
        wrhex   R3,
        wrhex   R5
        wrhex   R7
        mess    ,"move",NL
 ]
        Push    "R1"
        LDMDB   R1, {R8,R10,LR}
        STMIA   R2, {R8,R10,LR}
44
        CMPS    R1, R6
        LDMLOIA  R1, {R8,R10,LR}
        CMPLOS  R8, R3
        STMLODB  R1, {R8,R10,LR}
        ADDLO   R1, R1, #MoveEntry
        BLO     %BT44
        STMDB   R1, {R3,R5,R7}
        Pull    "R1"
        SUB     R1, R1, #MoveEntry
        B       %BT42

46
        MOV     R6, R1
        CMPS    R1, R9
        BHI     %BT40
        Pull    "R6,R11"

48
        LDMDB   R6, {R0-R2}     ;pick up last move
        SUBS    LR, R2, R11     ;if move exceeds buffer then split it
 [ DebugF :LAND: {FALSE}
        mess    GT,"splitting last move",NL
 ]
        STRGT   LR, [R6,#MoveLen-MoveEntry]
        ADDGT   R0, R0, LR
        ADDGT   R1, R1, LR
        STMGTIA  R6!,{R0,R1,R11}

        MOV     R3, R0, LSL #24
        MOV     R7, R6
50
        LDMDB   R7!,{R0-R2}
        TEQS    R3, R0, LSL #24
        ADDNE   R7, R7, #MoveEntry
        BNE     %FT52
        CMPS    R7, R9
        CMPHIS  R11,R2
        BHI     %BT50
52
        MOV     R8, R7
        BL      InitScatter
        sbaddr  R3, ScatterList
        MOV     R5, #0          ;init offset in buffer
 [ DebugF :LAND: {FALSE}
        mess    ,"read move sources into buffer",NL
 ]
54                      ;READ MOVE SOURCES INTO BUFFER SPOTTING IF CONTIGUOUS
        LDR     R2, [R8,#MoveSource]
        MOV     R4, #0
56
        LDMIA   R8, {R0,R1,LR}
        ADD     R1, R2, R4
        TEQS    R1, R0
        BNE     %FT58

        STR     R5, [R8,#MoveSource]    ;replace src address by buffer offset
        ADD     R4, R4, LR      ;adjust move total
        ADD     R5, R5, LR      ;adjust buffer offset
        ADD     R8, R8, #MoveEntry
        CMPS    R8, R6
        BLO     %BT56
58
        MOV     R1, #ReadSecsOp :OR: ScatterBit :OR: Atomic
 [ BigDisc
	ADR	LR, DoCompZoneBase
	LDR	LR, [LR]
	MOV	R0, LR, LSR #29
	DiscRecPtr R0,R0
	LDRB	R0, [R0, #SectorSize]	; and sector size
	ADD	R2, LR, R2, LSR R0	; reconstruct disc address
	BL	DoDiscOp		; and do the DiscOp
 |
        BIC     R2, R2, #&FF
        BL      DoDiscOp        ;(R1-R4->R0,R2-R4,V)
 ]
        BVS     %FT76
        CMPS    R8, R6
        BLO     %BT54           ;loop while more sources to read into buffer

        MOV     R0, R7          ;shift moves up enough to stop scatter list
        ADD     R1, R0, #ScatMin;overwriting them
        SUB     R2, R6, R7
        BL      BlockMove

        ADD     R5, R7, #ScatMin
        ADD     R6, R6, #ScatMin

                         ;INSERTION SORT DESTINATION MOVES
        MOV     R0, #0           ;dummy dest entry
        STR     R0, [R5,#MoveDest-MoveEntry]
        ADD     R8, R5, #MoveEntry
        B       %FT64
60
        SUB     R10,R8,#MoveEntry
62
        LDMDB   R10,{R3,R4,LR}          ;pick up previous entry
        CMPS    R4, R1                  ;IF later
        STMHSIA  R10,{R3,R4,LR}         ; move up previous entry
        SUBHS   R10,R10,#MoveEntry
        BHS     %BT62                   ; loop until earlier entry found
        STMIA   R10,{R0-R2}             ;put entry in correct place
64
        CMPS    R8, R6
        LDMLOIA  R8!,{R0-R2}            ;pick up entry
        BLO     %BT60                   ;loop if more
 [ DebugF :LAND: {FALSE}
        mess    ,"write moves from buffer to dests",NL
 ]
66                              ;EMPTY BUFFER SPOTTING CONTIGUOUS ON DISC
        MOV     R3, R7          ;init ptr to scatter list
        MOV     R4, #0          ;init length
        LDR     R2, [R5,#MoveDest]
68
        LDMIA   R5,{R1,R8,LR}  ;pick up buffer offset, dest, length
        ADD     R0, R2, R4
        TEQS    R8, R0
        BNE     %FT74           ;if not contiguous on disc leave for later

        ADD     R4, R4, LR
        sbaddr  R8, ScatterCopy
70                              ;loop to find buffer chunk containing start
        LDMIA   R8!,{R0,R10}    ;pick up (address,length) pair
        SUBS    R1, R1, R10
        BPL     %BT70
        ADD     R1, R1, R10
        ADD     R0, R0, R1      ;skip any unused start of buffer chunk
        SUB     R10,R10,R1
72
        CMPS    R10,LR          ;IF this buffer fragment does not contain end
        STMLOIA  R3!,{R0,R10}   ; add whole buffer chunk to scatter list
        SUBLO   LR, LR, R10     ; decrease length left to find
        LDMLOIA  R8!,{R0,R10}   ; and loop for next buffer chunk
        BLO     %BT72           ;ELSE
        STMIA   R3!,{R0,LR}     ; add partial buffer chunk to list

        ADD     R5, R5,#MoveEntry
        CMPS    R5, R6
        BLO     %BT68
74
        MOV     R1, #WriteSecsOp :OR: ScatterBit :OR: Atomic
        MOV     R3, R7
 [ BigDisc
	ADR	LR, DoCompZoneBase	;
	LDR	LR, [LR]		; get zone base addr
	MOV	R0, LR, LSR #29
	DiscRecPtr R0,R0
	LDRB	R0, [R0, #SectorSize]	; and sector size
	ADD	R2, LR, R2, LSR R0	; reconstruct disc address
	BL	DoDiscOp		; and do the DiscOp
 |
        BL      DoDiscOp        ;(R1-R4->R0,R2-R4,V)
 ]
        BVS     %FT76

        CMPS    R5, R6
        BLO     %BT66           ;loop if more to write out of buffer

        MOV     R6, R7
        CMPS    R7, R9
        BHI     %BT48           ;loop if more to read into buffer

        BL      WriteFsMap      ;(->R0,V)
        MOV     R3, R6
76
        BL      ReturnBuffer
95
        STRVS   R0, [SP]
 [ DebugF :LAND: {FALSE}
        wrhex   R0, VS
        wrhex   R3
        mess    ,"<DoCompMoves",NL
 ]
        Pull    "R0-R2,R4-R11,PC"

 ]

 ]

        LTORG
        END
