v4.0/src/DOS/ALLOC.ASM

   1 ;       SCCSID = @(#)alloc.asm  1.1 85/04/09
   2 TITLE ALLOC.ASM - memory arena manager
   3 NAME Alloc
   4 ;
   5 ; Memory related system calls and low level routines for MSDOS 2.X.
   6 ; I/O specs are defined in DISPATCH.
   7 ;
   8 ;   $ALLOC
   9 ;   $SETBLOCK
  10 ;   $DEALLOC
  11 ;   $AllocOper
  12 ;   arena_free_process
  13 ;   arena_next
  14 ;   check_signature
  15 ;   Coalesce
  16 ;
  17 ;   Modification history:
  18 ;
  19 ;       Created: ARR 30 March 1983
  20 ;
  21
  22 .xlist
  23 ;
  24 ; get the appropriate segment definitions
  25 ;
  26 include dosseg.asm
  27
  28 CODE    SEGMENT BYTE PUBLIC  'CODE'
  29         ASSUME  SS:DOSGROUP,CS:DOSGROUP
  30
  31 .xcref
  32 INCLUDE DOSSYM.INC
  33 INCLUDE DEVSYM.INC
  34 .cref
  35 .list
  36
  37 .lall
  38
  39 SUBTTL memory allocation utility routines
  40 PAGE
  41 ;
  42 ; arena data
  43 ;
  44         i_need  arena_head,WORD         ; seg address of start of arena
  45         i_need  CurrentPDB,WORD         ; current process data block addr
  46         i_need  FirstArena,WORD         ; first free block found
  47         i_need  BestArena,WORD          ; best free block found
  48         i_need  LastArena,WORD          ; last free block found
  49         i_need  AllocMethod,BYTE        ; how to alloc first(best)last
  50         I_need  EXTERR_LOCUS,BYTE       ; Extended Error Locus
  51
  52 ;
  53 ; arena_free_process
  54 ; input:    BX - PID of process
  55 ; output:   free all blocks allocated to that PID
  56 ;
  57         procedure   arena_free_process,NEAR
  58         ASSUME  DS:NOTHING,ES:NOTHING
  59         MOV     DI,arena_signature
  60         MOV     AX,[arena_head]
  61         CALL    Check_Signature         ; ES <- AX, check for valid block
  62
  63 arena_free_process_loop:
  64         retc
  65         PUSH    ES
  66         POP     DS
  67         CMP     DS:[arena_owner],BX     ; is block owned by pid?
  68         JNZ     arena_free_next         ; no, skip to next
  69         MOV     DS:[arena_owner],DI     ; yes... free him
  70
  71 arena_free_next:
  72         CMP     BYTE PTR DS:[DI],arena_signature_end
  73                                         ; end of road, Jack?
  74         retz                            ; never come back no more
  75         CALL    arena_next              ; next item in ES/AX carry set if trash
  76         JMP     arena_free_process_loop
  77
  78 EndProc arena_free_process
  79
  80 ;
  81 ; arena_next
  82 ; input:    DS - pointer to block head
  83 ; output:   AX,ES - pointers to next head
  84 ;           carry set if trashed arena
  85 ;
  86         procedure   arena_next,NEAR
  87         ASSUME  DS:NOTHING,ES:NOTHING
  88         MOV     AX,DS                   ; AX <- current block
  89         ADD     AX,DS:[arena_size]      ; AX <- AX + current block length
  90         INC     AX                      ; remember that header!
  91 ;
  92 ;       fall into check_signature and return
  93 ;
  94 ;       CALL    check_signature         ; ES <- AX, carry set if error
  95 ;       RET
  96 EndProc arena_next
  97
  98 ;
  99 ; check_signature
 100 ; input:    AX - address of block header
 101 ; output:   ES=AX, carry set if signature is bad
 102 ;
 103         procedure   check_signature,NEAR
 104         ASSUME  DS:NOTHING,ES:NOTHING
 105         MOV     ES,AX                   ; ES <- AX
 106         CMP     BYTE PTR ES:[DI],arena_signature_normal
 107                                         ; IF next signature = not_end THEN
 108         retz                            ;   GOTO ok
 109         CMP     BYTE PTR ES:[DI],arena_signature_end
 110                                         ; IF next signature = end then
 111         retz                            ;   GOTO ok
 112         STC                             ; set error
 113         return
 114
 115 EndProc Check_signature
 116
 117 ;
 118 ; Coalesce - combine free blocks ahead with current block
 119 ; input:    DS - pointer to head of free block
 120 ; output:   updated head of block, AX is next block
 121 ;           carry set -> trashed arena
 122 ;
 123         procedure   Coalesce,NEAR
 124         ASSUME  DS:NOTHING,ES:NOTHING
 125         CMP     BYTE PTR DS:[DI],arena_signature_end
 126                                         ; IF current signature = END THEN
 127         retz                            ;   GOTO ok
 128         CALL    arena_next              ; ES, AX <- next block, Carry set if error
 129         retc                            ; IF no error THEN GOTO check
 130
 131 coalesce_check:
 132         CMP     ES:[arena_owner],DI
 133         retnz                           ; IF next block isnt free THEN return
 134         MOV     CX,ES:[arena_size]      ; CX <- next block size
 135         INC     CX                      ; CX <- CX + 1 (for header size)
 136         ADD     DS:[arena_size],CX      ; current size <- current size + CX
 137         MOV     CL,ES:[DI]              ; move up signature
 138         MOV     DS:[DI],CL
 139         JMP     coalesce                ; try again
 140 EndProc Coalesce
 141
 142 SUBTTL $Alloc - allocate space in memory
 143 PAGE
 144 ;
 145 ;   Assembler usage:
 146 ;           MOV     BX,size
 147 ;           MOV     AH,Alloc
 148 ;           INT     21h
 149 ;         AX:0 is pointer to allocated memory
 150 ;         BX is max size if not enough memory
 151 ;
 152 ;   Description:
 153 ;           Alloc returns  a  pointer  to  a  free  block of
 154 ;       memory that has the requested  size  in  paragraphs.
 155 ;
 156 ;   Error return:
 157 ;           AX = error_not_enough_memory
 158 ;              = error_arena_trashed
 159 ;
 160         procedure   $ALLOC,NEAR
 161         ASSUME  DS:NOTHING,ES:NOTHING
 162
 163         EnterCrit   critMem
 164         XOR     AX,AX
 165         MOV     DI,AX
 166
 167         MOV     [FirstArena],AX         ; init the options
 168         MOV     [BestArena],AX
 169         MOV     [LastArena],AX
 170
 171         PUSH    AX                      ; alloc_max <- 0
 172         MOV     AX,[arena_head]         ; AX <- beginning of arena
 173         CALL    Check_signature         ; ES <- AX, carry set if error
 174         JC      alloc_err               ; IF error THEN GOTO err
 175
 176 alloc_scan:
 177         PUSH    ES
 178         POP     DS                      ; DS <- ES
 179         CMP     DS:[arena_owner],DI
 180         JZ      alloc_free              ; IF current block is free THEN examine
 181
 182 alloc_next:
 183         CMP     BYTE PTR DS:[DI],arena_signature_end
 184                                         ; IF current block is last THEN
 185         JZ      alloc_end               ;   GOTO end
 186         CALL    arena_next              ; AX, ES <- next block, Carry set if error
 187         JNC     alloc_scan              ; IF no error THEN GOTO scan
 188
 189 alloc_err:
 190         POP     AX
 191
 192 alloc_trashed:
 193         LeaveCrit   critMem
 194         error   error_arena_trashed
 195
 196 alloc_end:
 197         CMP     [FirstArena],0
 198         JNZ     alloc_do_split
 199
 200 alloc_fail:
 201         invoke  get_user_stack
 202         POP     BX
 203         MOV     [SI].user_BX,BX
 204         LeaveCrit   critMem
 205         error   error_not_enough_memory
 206
 207 alloc_free:
 208         CALL    coalesce                ; add following free block to current
 209         JC      alloc_err               ; IF error THEN GOTO err
 210         MOV     CX,DS:[arena_size]
 211
 212         POP     DX                      ; check for max found size
 213         CMP     CX,DX
 214         JNA     alloc_test
 215         MOV     DX,CX
 216
 217 alloc_test:
 218         PUSH    DX
 219         CMP     BX,CX                   ; IF BX > size of current block THEN
 220         JA      alloc_next              ;   GOTO next
 221
 222         CMP     [FirstArena],0
 223         JNZ     alloc_best
 224         MOV     [FirstArena],DS         ; save first one found
 225 alloc_best:
 226         CMP     [BestArena],0
 227         JZ      alloc_make_best         ; initial best
 228         PUSH    ES
 229         MOV     ES,[BestArena]
 230         CMP     ES:[arena_size],CX      ; is size of best larger than found?
 231         POP     ES
 232         JBE     alloc_last
 233 alloc_make_best:
 234         MOV     [BestArena],DS          ; assign best
 235 alloc_last:
 236         MOV     [LastArena],DS          ; assign last
 237         JMP     alloc_next
 238
 239 ;
 240 ; split the block high
 241 ;
 242 alloc_do_split_high:
 243         MOV     DS,[LastArena]
 244         MOV     CX,DS:[arena_size]
 245         SUB     CX,BX
 246         MOV     DX,DS
 247         JE      alloc_set_owner         ; sizes are equal, no split
 248         ADD     DX,CX                   ; point to next block
 249         MOV     ES,DX                   ; no decrement!
 250         DEC     CX
 251         XCHG    BX,CX                   ; bx has size of lower block
 252         JMP     alloc_set_sizes         ; cx has upper (requested) size
 253
 254 ;
 255 ; we have scanned memory and have found all appropriate blocks
 256 ; check for the type of allocation desired; first and best are identical
 257 ; last must be split high
 258 ;
 259 alloc_do_split:
 260         CMP     BYTE PTR [AllocMethod], 1
 261         JA      alloc_do_split_high
 262         MOV     DS,[FirstArena]
 263         JB      alloc_get_size
 264         MOV     DS,[BestArena]
 265 alloc_get_size:
 266         MOV     CX,DS:[arena_size]
 267         SUB     CX,BX                   ; get room left over
 268         MOV     AX,DS
 269         MOV     DX,AX                   ; save for owner setting
 270         JE      alloc_set_owner         ; IF BX = size THEN (don't split)
 271         ADD     AX,BX
 272         INC     AX                      ; remember the header
 273         MOV     ES,AX                   ; ES <- DS + BX (new header location)
 274         DEC     CX                      ; CX <- size of split block
 275 alloc_set_sizes:
 276         MOV     DS:[arena_size],BX      ; current size <- BX
 277         MOV     ES:[arena_size],CX      ; split size <- CX
 278         MOV     BL,arena_signature_normal
 279         XCHG    BL,DS:[DI]              ; current signature <- 4D
 280         MOV     ES:[DI],BL              ; new block sig <- old block sig
 281         MOV     ES:[arena_owner],DI
 282
 283 alloc_set_owner:
 284         MOV     DS,DX
 285         MOV     AX,[CurrentPDB]
 286         MOV     DS:[arena_owner],AX
 287         MOV     AX,DS
 288         INC     AX
 289         POP     BX
 290         LeaveCrit   critMem
 291         transfer    SYS_RET_OK
 292
 293 EndProc $alloc
 294
 295 SUBTTL $SETBLOCK - change size of an allocated block (if possible)
 296 PAGE
 297 ;
 298 ;   Assembler usage:
 299 ;           MOV     ES,block
 300 ;           MOV     BX,newsize
 301 ;           MOV     AH,setblock
 302 ;           INT     21h
 303 ;         if setblock fails for growing, BX will have the maximum
 304 ;         size possible
 305 ;   Error return:
 306 ;           AX = error_invalid_block
 307 ;              = error_arena_trashed
 308 ;              = error_not_enough_memory
 309 ;              = error_invalid_function
 310 ;
 311         procedure   $SETBLOCK,NEAR
 312         ASSUME  DS:NOTHING,ES:NOTHING
 313         EnterCrit   critMem
 314         MOV     DI,arena_signature
 315         MOV     AX,ES
 316         DEC     AX
 317         CALL    check_signature
 318         JNC     setblock_grab
 319
 320 setblock_bad:
 321         JMP     alloc_trashed
 322
 323 setblock_grab:
 324         MOV     DS,AX
 325         CALL    coalesce
 326         JC      setblock_bad
 327         MOV     CX,DS:[arena_size]
 328         PUSH    CX
 329         CMP     BX,CX
 330         JBE     alloc_get_size
 331         JMP     alloc_fail
 332 EndProc $setblock
 333
 334 SUBTTL $DEALLOC - free previously allocated piece of memory
 335 PAGE
 336 ;
 337 ;   Assembler usage:
 338 ;           MOV     ES,block
 339 ;           MOV     AH,dealloc
 340 ;           INT     21h
 341 ;
 342 ;   Error return:
 343 ;           AX = error_invalid_block
 344 ;              = error_arena_trashed
 345 ;
 346         procedure   $DEALLOC,NEAR
 347         ASSUME  DS:NOTHING,ES:NOTHING
 348         EnterCrit   critMem
 349         MOV     DI,arena_signature
 350         MOV     AX,ES
 351         DEC     AX
 352         CALL    check_signature
 353         JC      dealloc_err
 354         MOV     ES:[arena_owner],DI
 355         LeaveCrit   critMem
 356         transfer    SYS_RET_OK
 357
 358 dealloc_err:
 359         LeaveCrit   critMem
 360         error   error_invalid_block
 361 EndProc $DEALLOC
 362
 363 SUBTTL $AllocOper - get/set allocation mechanism
 364 PAGE
 365 ;
 366 ;   Assembler usage:
 367 ;           MOV     AH,AllocOper
 368 ;           MOV     BX,method
 369 ;           MOV     AL,func
 370 ;           INT     21h
 371 ;
 372 ;   Error return:
 373 ;           AX = error_invalid_function
 374 ;
 375         procedure   $AllocOper,NEAR
 376         ASSUME  DS:NOTHING,ES:NOTHING
 377         CMP     AL,1
 378         JB      AllocOperGet
 379         JZ      AllocOperSet
 380         MOV     EXTERR_LOCUS,errLoc_mem ; Extended Error Locus
 381         error   error_invalid_function
 382 AllocOperGet:
 383         MOV     AL,BYTE PTR [AllocMethod]
 384         XOR     AH,AH
 385         transfer    SYS_RET_OK
 386 AllocOperSet:
 387         MOV     [AllocMethod],BL
 388         transfer    SYS_RET_OK
 389 EndProc $AllocOper
 390
 391 CODE    ENDS
 392     END