chiark - git - mdw - ssr/blob - StraySrc/Libraries/Sapphire/s/subAlloc

   1 ;
   2 ; suballoc.s
   3 ;
   4 ; Handling of requests for small link blocks (MDW)
   5 ;
   6 ; © 1994-1998 Straylight
   7 ;
   8
   9 ;----- Licensing note -------------------------------------------------------
  10 ;
  11 ; This file is part of Straylight's Sapphire library.
  12 ;
  13 ; Sapphire is free software; you can redistribute it and/or modify
  14 ; it under the terms of the GNU General Public License as published by
  15 ; the Free Software Foundation; either version 2, or (at your option)
  16 ; any later version.
  17 ;
  18 ; Sapphire is distributed in the hope that it will be useful,
  19 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ; GNU General Public License for more details.
  22 ;
  23 ; You should have received a copy of the GNU General Public License
  24 ; along with Sapphire.  If not, write to the Free Software Foundation,
  25 ; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  26
  27 ;----- Standard header ------------------------------------------------------
  28
  29                 GET     libs:swis
  30                 GET     libs:header
  31
  32 ;----- External dependencies ------------------------------------------------
  33
  34                 GET     sapphire:alloc
  35                 GET     sapphire:mem
  36                 GET     sapphire:sapphire
  37
  38 ;----- Word to the wise -----------------------------------------------------
  39 ;
  40 ; Various bits of Sapphire require lots of small blocks for linked lists and
  41 ; things.  To avoid mangling the heap, we allocate very big blocks and then
  42 ; split them up into littler ones.  These big blocks just contain lots of
  43 ; little ones.
  44 ;
  45 ; The data blocks are allocated such that they are just big enough for the
  46 ; data -- the caller must specify the actual size of the block when freeing.
  47 ; Completely free big blocks just stay in the heap ready to be allocated
  48 ; again by this system.  They are not returned to the heap.
  49 ;
  50 ; We keep a table of pointers to the big block lists for each supported
  51 ; block size.  This is rather like the `bins' idea in the C library malloc
  52 ; algorithms.
  53
  54 ;----- Main code ------------------------------------------------------------
  55
  56                 AREA    |Sapphire$$Code|,CODE,READONLY
  57
  58 ; --- sub_alloc ---
  59 ;
  60 ; On entry:     R0 == size of block to allocate
  61 ;
  62 ; On exit:      R0 == pointer to block allocated
  63 ;               May return an error
  64 ;
  65 ; Use:          Allocates a block of the size specified, typically very
  66 ;               quickly indeed.
  67 ;
  68 ;               If the size is not one of those supported (currently
  69 ;               supported sizes are 8-40 inclusive in 4 byte increments),
  70 ;               the behaviour is undefined (but very predictable).
  71
  72                 EXPORT  sub_alloc
  73 sub_alloc       ROUT
  74
  75                 STMFD   R13!,{R1-R3,R12,R14}
  76
  77                 ; --- Find the correct table entry ---
  78
  79                 WSPACE  sub__wSpace             ;Find my workspace
  80                 ADD     R1,R12,R0               ;Find the entry in the table
  81
  82                 ; --- Are there any free blocks? ---
  83
  84                 LDR     R2,[R1]                 ;Get the free list offset
  85                 CMP     R2,#0                   ;Are there any free blocks?
  86                 BEQ     %20sub_alloc            ;No -- better allocate some
  87
  88                 ; --- Mess about with the free list and return ---
  89
  90 10sub_alloc     LDR     R0,[R2]                 ;Get next pointer from block
  91                 STR     R0,[R1]                 ;This is now first free block
  92                 MOV     R0,R2                   ;Return the old free block
  93                 LDMFD   R13!,{R1-R3,R12,R14}    ;Restore registers and return
  94                 BICS    PC,R14,#V_flag          ;Clear error as we leave
  95
  96                 ; --- Create a big block ---
  97                 ;
  98                 ; We're now using alloc for this.  To avoid extra memory
  99                 ; usage, we nobble alloc's `extra' word which allows it
 100                 ; to find the free routine, because we'll never free it
 101                 ; anyway!
 102
 103 20sub_alloc     MOV     R2,R0                   ;Keep the size safe
 104                 MOV     R0,R0,LSL #3            ;Find the chunk size
 105                 SUB     R0,R0,#4                ;This is evil.  I don't care
 106                 BL      alloc                   ;Allocate some memory
 107                 BCS     %90sub_alloc            ;If failed, report error
 108                 SUB     R0,R0,#4                ;Gobble alloc's overhead
 109
 110                 ; --- Now set up the links for the free list ---
 111
 112                 MOV     R14,#0                  ;Next free pointer start at 0
 113                 MOV     R3,#8                   ;We have 8 blocks to do
 114 00              STR     R14,[R0],R2             ;Store in next field
 115                 SUB     R14,R0,R2               ;Remember old block pointer
 116                 SUBS    R3,R3,#1                ;Point to previous block
 117                 BGT     %b00                    ;If more to do, continue...
 118
 119                 ; --- The links are set up -- now take off a block ---
 120
 121                 MOV     R2,R14                  ;Use last block allocated
 122                 B       %10sub_alloc            ;Then allocate as normal
 123
 124                 ; --- Handle an error ---
 125
 126 90              BL      alloc_error             ;Find the error message
 127                 LDMFD   R13!,{R1-R3,R12,R14}    ;Restore registers
 128                 ORRS    PC,R14,#V_flag          ;And return the error
 129
 130                 LTORG
 131
 132 ; --- sub_free ---
 133 ;
 134 ; On entry:     R0 == pointer to block
 135 ;               R1 == size of the block
 136 ;
 137 ; On exit:      --
 138 ;
 139 ; Use:          Frees a block allocated using sub_alloc.
 140
 141                 EXPORT  sub_free
 142 sub_free        ROUT
 143
 144                 STMFD   R13!,{R0,R1,R12,R14}    ;Preserve registers
 145
 146                 ; --- Find the correct table entry ---
 147
 148                 WSPACE  sub__wSpace             ;Find my workspace
 149                 ADD     R1,R12,R1               ;Find the entry in the table
 150
 151                 ; --- Mess about with the list ---
 152
 153                 LDR     R14,[R1]                ;Get current first block
 154                 STR     R14,[R0]                ;Store in newly freed block
 155                 STR     R0,[R1]                 ;And insert new block in list
 156                 LDMFD   R13!,{R0,R1,R12,PC}^    ;Oh, and return to caller
 157
 158                 LTORG
 159
 160 ; --- sub_init ---
 161 ;
 162 ; On entry:     --
 163 ;
 164 ; On exit:      --
 165 ;
 166 ; Use:          Initialises the suballocation system for use.
 167
 168                 EXPORT  sub_init
 169 sub_init        ROUT
 170
 171                 STMFD   R13!,{R0-R2,R12,R14}    ;Save some registers
 172                 WSPACE  sub__wSpace             ;Find my workspace
 173
 174                 ; --- Am I initialised? ---
 175
 176                 LDR     R14,sub__flags          ;Get my flags word
 177                 TST     R14,#sub__INITED        ;Test the flag
 178                 LDMNEFD R13!,{R0-R2,R12,PC}^    ;Yes -- return to caller
 179
 180                 ; --- Set up the workspace properly ---
 181
 182                 ORR     R14,R14,#sub__INITED    ;We are now initialised
 183                 STR     R14,sub__flags          ;Store it in the flags
 184                 ADD     R0,R12,#4               ;Point to the table
 185                 MOV     R1,#10*4                ;Number of entries supported
 186                 MOV     R2,#0                   ;Zero them all
 187                 BL      mem_set                 ;Zero-initialise my workspace
 188                 BL      alloc_init              ;Make sure alloc is awake
 189                 LDMFD   R13!,{R0-R2,R12,PC}^    ;Return to caller
 190
 191                 LTORG
 192
 193 sub__wSpace     DCD     0
 194
 195 ;----- Workspace ------------------------------------------------------------
 196
 197                 ^       0,R12
 198 sub__wStart     #       0
 199
 200 sub__flags      #       0                       ;Various interesting flags
 201
 202 sub__INITED     EQU     (1<<0)                  ;Am I initialised?
 203
 204 sub__table      #       4*10                    ;The suballoc root table
 205
 206 sub__wSize      EQU     {VAR}-sub__wStart
 207
 208                 AREA    |Sapphire$$LibData|,CODE,READONLY
 209
 210                 DCD     sub__wSize
 211                 DCD     sub__wSpace
 212                 DCD     0
 213                 DCD     sub_init
 214
 215 ;----- That's all folks -----------------------------------------------------
 216
 217                 END