v2.0/source/ALLOC.ASM

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