; 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.
;
; this OS_Module equivalent looks at ptr-4 which the Heap Manager uses
; to store the real size of the block. In this way the memory use is
; more efficient (especially when extending a block) and RMA should
; fragment less often.

        [ DebugMemory

debug_memory
        DCB     "WIMP memory debugging",0
        ALIGN

XROS_Module ENTRY
        TEQ     R0,#6
        TEQNE   R0,#7
        TEQNE   R0,#13

        LDREQB  R14,reentrancyflag
        TEQEQ   R14,#0
        SWINE   XOS_Module
        EXIT    NE

        TEQ     R0,#6
        BEQ     ros_claim
        TEQ     R0,#7
        BEQ     ros_free
; extend

; check to see if on claim list
        CMP     R2,#-1
        MOVEQ   R0,#ModHandReason_Claim
        BLEQ    XROS_Module
        MOVEQ   R0,#ModHandReason_ExtendBlock
        EXITS   EQ

        Push    R0

        ADRL    R0,memory_claims
        LDR     R0,[R0]
        CMP     R0,#0

        BLE     %FT07
05
        LDR     R14,[R0],#8
        TEQ     R14,R2
        Push    R0,EQ

        BEQ     %FT09

        CMP     R14,#-1
        BNE     %BT05
        B       %FT07
09
        Push    "R3-R5"
        LDR     R4,[R2,#-8]
        LDR     R5,[R2,#-4]!
        ADD     R5,R5,R3                        ; R5 is proposed new size

        [ true
        CMP     R5,#4
        BLE     extend_to_zero                    ; shrunk to zero size.
        ]

        SUB     R4,R4,#4
        CMP     R4,R5
        CMPGE   R3,#0
        BLT     %FT02
        STR     R5,[R2],#4                      ; enough space so just store
        Pull    "R3-R5"
        CLRV

        ADD     SP,SP,#4
        Pull    R0

        EXITS
02
        SUB     R3,R5,R4
        MOV     R0,#ModHandReason_ExtendBlock
        SWI     XOS_Module
        STRVC   R5,[R2],#4
        Pull    "R3-R5"
        BVS     %FT95

        Pull    R0
        STR     R2,[R0,#-8]
        Pull    R0
        EXITS
95
        ADD     sp,sp,#8
        EXIT

extend_to_zero
        Pull    "R3-R5"
        CLRV
        ADD     SP,SP,#4
        ADD     R2,R2,#4
        MOV     R0,#ModHandReason_Free
        BL      XROS_Module
        MOV     R2,#-1
        Pull    R0
        EXITS

ros_free
;        STR     R2,[R2,#-4]!           ; uncomment for debugging

; check to see if on claim list
        Push    R0
        ADRL    R0,memory_claims
        LDR     R0,[R0]
        CMP     R0,#0

        BLE     %FT07

05
        LDR     R14,[R0],#8
        TEQ     R14,R2
        BEQ     %FT09

        CMP     R14,#-1
        BNE     %BT05
07
; oh dear, trying to free something that didn't exist
        LDR     R0,[SP,#4]                 ; pc
        BIC     R0,R0,#&fc000003

        Push    R1-R7
        SUB     SP,SP,#256
        MOV     R1,SP
        MOV     R2,#16
        SWI     XOS_ConvertHex8
        ADD     R1,sp,#16
        MOV     R2,#16
        LDR     R0,[sp,#256+4]
        SWI     XOS_ConvertHex8
        ADR     R1,noclaim+4
        MOV     R0,#0
        ADD     R2,SP,#32
        MOV     R3,#224
        ADD     R4,SP,#16
        MOV     R5,sp
        MOV     R6,#0
        MOV     R7,#0
        SWI     XMessageTrans_Lookup
        ADD     R0,SP,#28
        MOV     R1,#1
        MOV     R2,#0
        SWI     Wimp_ReportError
        ADD     SP,SP,#256
        Pull    R1-R7
        SETV
        ADD     SP,SP,#4
        EXIT

09
        Push    R1
        SUB     R1,R0,#8                        ; remove entry
14
        LDR     R14,[R0],#4
        STR     R14,[R1],#4
        CMP     R14,#-1
        BNE     %BT14
        Pull    R1
        Pull    R0

        SUB     R2,R2,#4
        SWI     XOS_Module
        EXIT    VS

        Push    "R0-R3"
        ADRL    R0,memory_claims
        LDR     R1,[R0,#4]                      ; need area number
        LDR     R2,[R0]
        MOV     R0,#ModHandReason_ExtendBlock
        MOV     R3,#-8
        BL      ExtendList
        Pull    "R0-R3"
        EXITS

ros_claim
        ADD     R3,R3,#4
        SWI     XOS_Module
        EXIT    VS

        STR     R3,[R2],#4                      ; so modptr-4 = ammount asked for + 4
        SUB     R3,R3,#4                        ; needs to be preserved

; add address to list of claims
        Push    R0-R1
        ADRL    R0,memory_claims
; will be -1 to start with
        Push    "R1-R3,R8"
        LDR     R2,[R0]
        LDR     R1,[R0,#4]
        CMP     R1,#-1
        BNE     %FT99

        MOV     R0,#ModHandReason_Claim
        MOV     R3,#16
        ADR     R8,debug_memory

        BL      ExtendList

        MOV     R14,#-1
        STR     R14,[R2]

        ADRL    R0,memory_claims
        STR     R1,[R0,#4]                      ; area number
        STR     R2,[R0]
        MOV     R0,R2
        Pull    "R1-R3,R8"
        B       %FT05

99
        MOV     R0,#ModHandReason_ExtendBlock
        MOV     R3,#8
        CLRV
        BL      ExtendList

        Pull    "R1-R3,R8",VS
        BVS     %FT08

        MOV     R0,R2
        Pull    "R1-R3,R8"
05
        LDR     R14,[R0],#8
        CMP     R14,#-1
        BNE     %BT05

        STR     R2,[R0,#-8]
        LDR     R1,[sp,#8]                      ; pc
        STR     R1,[R0,#-4]
        STR     R14,[R0]
08
        Pull    R0-R1

        EXITS

noclaim
        DCD     0
        DCB     "DF:An area (%0) which has already been freed (or not previously claimed) has tried to be freed from %1.",0

ExtendList
        Push    R14
        MOV     R14,#1
        STRB    R14,reentrancyflag
        BL      Dynamic_Module
        MOV     R14,#0
        STRB    R14,reentrancyflag
        Pull    PC,VC,^
        Pull    PC

        |

XROS_Module ENTRY
        TEQ     R0,#6
        TEQNE   R0,#7
        TEQNE   R0,#13
        SWINE   XOS_Module
        EXIT    NE
        TEQ     R0,#6
        BEQ     ros_claim
        TEQ     R0,#7
        BEQ     ros_free
; extend
        Push    "R3-R5"
        LDR     R4,[R2,#-8]
        LDR     R5,[R2,#-4]!
        ADD     R5,R5,R3                        ; R5 is proposed new size
        SUB     R4,R4,#4
        CMP     R4,R5
        CMPGE   R3,#0
        BLT     %FT02
        STR     R5,[R2],#4                      ; enough space so just store
        Pull    "R3-R5"
; can never error
        EXITS
02
        SUB     R3,R5,R4
        SWI     XOS_Module
        STRVC   R5,[R2],#4
        Pull    "R3-R5"
        EXITS   VC
        EXIT


ros_free
        SUB     R2,R2,#4
        SWI     XOS_Module
        EXITS   VC
        EXIT

ros_claim
        ADD     R3,R3,#4
        SWI     XOS_Module
        STRVC   R3,[R2],#4                      ; so modptr-4 = ammount asked for + 4
        SUB     R3,R3,#4                        ; needs to be preserved
        EXITS   VC
        EXIT
        ]

; provide OS_Heap memory facilities with a dynamic area
; entry R0 - reasoncode
;       R1 - area to use
;       R2 - pointer to memory
;       R3 - size
;       R8 - string for TM
; exit  R2 updated, and possibly R1

      [ Medusa
                      ;max size of dynamic area (-1 would be very wasteful of address space on big machines)
                      GBLA    WimpSpritePoolMaxSize
WimpSpritePoolMaxSize SETA    16*1024*1024
      ]

Dynamic_Module
        Push    lr
      [ :LNOT:Medusa
        BL      XROS_Module
        MOV     R1,R2
        Pull    PC,VS
        Pull    PC,,^

      | ; Medusa
05
        Push    "R0-R9"
        MOV     R14,#1
        STRB    R14,memoryOK
        TEQ     R0,#ModHandReason_ExtendBlock
        BNE     %FT10
; do we need to increase size of area?
        LDR     R4,[R2,#-8]                     ; maximum size currently
        LDR     R5,[R2,#-4]                     ; current used size
        Debug   nk,"Extend Area (max size, used size, change) ",R4,R5,R3
        ADD     R5,R5,R3                        ; proposed new size
        CMP     R4,R5
        BLT     %FT05
        CMP     R3,#0
        BLT     %FT02
        STR     R5,[R2,#-4]
        CLRV
        B       %FT95
02
; change is negative so try and shrink by proposed size - total size
        MOV     R0,R1
        SUB     R1,R5,R4
        Debug   nk,"Sprite area (at,increase) ",R2,R1
        SWI     XOS_ChangeDynamicArea
        Debug   nk,"actual change",R1
        STRVC   R5,[R2,#-4]
        SUBVC   R4,R4,R1                        ; remember R1 is +ve
        STRVC   R4,[R2,#-8]
        B       %FT95
05
        MOV     R0,R1
        SUB     R1,R5,R4

        Debug   nk,"Sprite area (at,increase) ",R2,R1

        SWI     XOS_ChangeDynamicArea
        Debug   nk,"actual change",R1

        STRVC   R5,[R2,#-4]
        ADDVC   R4,R4,R1
        STRVC   R4,[R2,#-8]
        B       %FT95
10
        TEQ     R0,#ModHandReason_Claim
        BNE     %FT20
        MOV     R0,#0
        ADD     R2,R3,#8                        ; need two more words
        MOV     R3,#-1
        MOV     R4,#128                         ; not dragable
        MOV     R5,#WimpSpritePoolMaxSize
        ADRL    R6,wimp_area_handler
        MOV     R7,R12
        SWI     XOS_DynamicArea
        BVS     %FT95
; now have to find out how much space was actually allocated
        STR     R1,[sp,#4]
        MOV     R0,R1                           ; area number
        SWI     XOS_ReadDynamicArea
        SUB     R1,R1,#8
        STR     R1,[R0]                         ; Area+0 is current allocated size
        LDR     R1,[sp,#12]
        STR     R1,[R0,#4]                      ; Area+4 is current 'claimed' size
        B       %FT95
20
        TEQ     R0,#ModHandReason_Free
        BNE     %FT98
        MOV     R0,#1
        SWI     XOS_DynamicArea
        B       %FT98
95
        LDRVC   R0,[sp,#4]
        SWIVC   XOS_ReadDynamicArea
        ADDVC   R0,R0,#8                        ; first two words are for 'book-keeping'
        STRVC   R0,[sp,#8]                      ; so R2 always -> area
98
        MOV     R1,#0
        STRB    R1,memoryOK
        STRVS   R0,[SP]

        Pull    "R0-R9,PC",VS
        Pull    "R0-R9,PC",,^

      ]

        END