     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                                  [list -]
    22          ******************       warning: redefining multi-line macro `struc' [-w+pp-macro-redef-multi]
    14                              <4> [list -]
    14                              <3> [list -]
     3                              <2> 
     4                              <2> addsection DOSSTART, align=16 PUBLIC class=DOSSTART
     5                              <2> ; (no prior section) ; DOSSTART		ENDS
     6                              <2> 
     7                              <2> addsection DOSSTARTJUMP, align=1 PUBLIC class=START
     8                              <2> ; (no prior section) ; DOSSTARTJUMP		ENDS
     9                              <2> 
    10                              <2> addsection CONSTANTS, align=2 PUBLIC class=CONST
    11                              <2> ; (no prior section) ; CONSTANTS	ENDS
    12                              <2> 
    13                              <2> addsection DATA, align=2 PUBLIC class=DATA
    14                              <2> ; (no prior section) ; DATA		ENDS
    15                              <2> 
    16                              <2> addsection TABLE, align=2 PUBLIC class=TABLE
    17                              <2> ; (no prior section) ; TABLE		ENDS
    18                              <2> 
    19                              <2> addsection DOSDATATABLE, align=2 PUBLIC class=DOSDATACODE
    20                              <2> ; (no prior section) ; DOSDATATABLE		ENDS
    21                              <2> 
    22                              <2> addsection DOSDATACODE, align=1 PUBLIC class=DOSDATACODE
    23                              <2> ; (no prior section) ; DOSDATACODE		ENDS
    24                              <2> 
    25                              <2> addsection DOSBIODATA, align=2 PUBLIC class=DOSBIODATA
    26                              <2> 
    27                              <2> addsection LAST, align=16 PUBLIC class=LAST
    28                              <2> ; (no prior section) ; LAST		ENDS
    29                              <2> 
    30                              <2> group DOSGROUP DOSSTART DOSSTARTJUMP CONSTANTS DATA TABLE DOSDATATABLE DOSDATACODE DOSBIODATA LAST
     8                              <1> 
     9                              <1> %include "dcodeseg.nas"
     1                              <2> 
     2                              <2> %ifndef DCODESEGNAS
     3                              <2> %assign DCODESEGNAS 1
     4                              <2> 
     5                              <2> section DOSCODETABLE align=2 PUBLIC class=DOSCODE
     6                              <2> ; (no prior section) ; DOSCODETABLE		ENDS
     7                              <2> section DOSCODECODE align=1 PUBLIC class=DOSCODE
     8                              <2> ; (no prior section) ; DOSCODECODE		ENDS
     9                              <2> section DOSBIOCODE align=2 PUBLIC class=DOSCODE
    10                              <2> section BIOCODE	align=2 PUBLIC class=DOSCODE
    11                              <2> 
    12                              <2> %ifnidni DOSENTRYGROUP, DOSCODEGROUP
    13                              <2>  group DOSCODEGROUP DOSCODETABLE DOSCODECODE DOSBIOCODE BIOCODE
    14                              <2> %endif
    15                              <2> 
    16                              <2> %endif
    10                              <1> 
    11                              <1> section LAST
    12                              <1> ; (no prior section) ; LAST		ENDS
    27                                  
    28                                  [list +]
    29                                  section DOSCODECODE
    30                                  [list -]
    30          ******************       warning: out: ... for DOS Version 4.00 ... [-w+user]
    30          ******************       warning: out: BPB.INC... [-w+user]
    30          ******************       warning: out: ... CLONE version build switch on ... [-w+user]
    30          ******************       warning: out: DEVSYM.INC... [-w+user]
    36                                  %include "memsw.mac"
     1                              <1> %define LDOSMEM 1
    37                                  ;.cref
    38                                  [list +]
    39                                  
    40                                  ;.lall
    41                                  
    42                                  ;SUBTTL memory allocation utility routines
    43                                  ;PAGE
    44                                  ;
    45                                  ; arena data
    46                                  ;
    47                                  	i_need  arena_head,WORD         ; seg address of start of arena
    48                                  first_mcb equ arena_head
    49                                  	I_need	first_umcb, word
    50                                  	i_need  CurrentPDB,WORD         ; current process data block addr
    51                                  	i_need  FirstArena,WORD         ; first free block found
    52                                  	i_need  BestArena,WORD          ; best free block found
    53                                  	i_need  LastArena,WORD          ; last free block found
    54                                  	i_need  AllocMethod,BYTE        ; how to alloc first(best)last
    55                                  	I_need	alloc_strategy_ext, byte
    56                                  	I_need	enable_uma, byte
    57                                  	I_need  EXTERR_LOCUS,BYTE       ; Extended Error Locus
    58                                  
    59                                  %ifdef LDOSMEM
    60                                  getpsp:
    61                                   assume ds:nothing, es:nothing, ss:DOSGROUP
    62 00000000 368B1E[0000]            	mov bx, word [ss:CurrentPDB]
    63 00000005 C3                      	retn
    64                                  
    65                                  %assign _UMA 1
    66                                  %assign _ERRORFLAGS 0
    67                                  
    68                                  section DOSCODECODE
    69                                  
    70                                  %include "memory.asm"
     1                              <1> 
     2                              <1> %if 0
     3                              <1> 
     4                              <1> lDOS memory handling
     5                              <1>  by E. C. Masloch, 2018--2025
     6                              <1> 
     7                              <1> Usage of the works is permitted provided that this
     8                              <1> instrument is retained with the works, so that any entity
     9                              <1> that uses the works is notified of this instrument.
    10                              <1> 
    11                              <1> DISCLAIMER: THE WORKS ARE WITHOUT WARRANTY.
    12                              <1> 
    13                              <1> %endif
    14                              <1> 
    15                              <1> %if 0
    16                              <1> 
    17                              <1> Inside most functions, di is set to zero and used as index register to access
    18                              <1> MCB fields (this allows the assembler to use byte offsets resulting in smaller
    19                              <1> instructions). It's also used whenever a register with the value zero is handy,
    20                              <1> for example, when ClearMCB wants to free the MCB by setting the owner word to
    21                              <1> zero.
    22                              <1> 
    23                              <1> Most functions access the current working MCB with ds. CollectNextFreeMCB
    24                              <1> accesses the secondary MCB (which is to be removed) with es.
    25                              <1> 
    26                              <1> --
    27                              <1> 
    28                              <1> The separate CheckMCBs function has been removed. To check the MCB chain, call
    29                              <1> ReleaseOwnersMCBs with bx set to zero. The returned status indicates whether
    30                              <1> the MCB chain is invalid. (This also resets the mcbName field of all already
    31                              <1> free MCBs, but that shouldn't be an issue.)
    32                              <1> 
    33                              <1> --
    34                              <1> 
    35                              <1> As you may note, the functions are mostly ordered from those performing simple
    36                              <1> or preparatory tasks to those more complex, calling the simpler ones. The last
    37                              <1> functions are ModifyMCBRandom (which takes an address and resizes that MCB as
    38                              <1> requested) and AllocateMCBRandom (which searches through the MCBs and decides
    39                              <1> which one to reserve depending on the requested allocation strategy).
    40                              <1> 
    41                              <1> --
    42                              <1> 
    43                              <1> Note that the MS-DOS-compatible UMB link and memory allocation strategies
    44                              <1> for allocation behave as follows:
    45                              <1> 
    46                              <1> UMB link? -->	Off			On
    47                              <1> v Strategy area
    48                              <1> 00h		LMA only		LMA then UMA, as one area
    49                              <1> 40h		LMA only		UMA only, as one area
    50                              <1> 80h		LMA only		UMA as one area, then LMA as one area
    51                              <1> 
    52                              <1> In particular, "UMA then LMA" (80h) treats the two areas as distinct areas
    53                              <1> for the search; if a UMA block is found that satisfies the search, it is
    54                              <1> used, even if a better (best-fit) or later (last-fit) block would be found
    55                              <1> in the LMA. (For first-fit, there is no difference.)
    56                              <1> 
    57                              <1> Our original implementation treated the "UMA then LMA" (80h) strategy area
    58                              <1> as one area for the search, which for best-fit and last-fit differs.
    59                              <1> 
    60                              <1> --
    61                              <1> 
    62                              <1> The default now is to behave compatible to MS-DOS, that is, UMA then LMA
    63                              <1> is handled as two areas, while LMA then UMA is handled as one area.
    64                              <1> Setting the flag 2 in the high byte of the allocation strategy (stored
    65                              <1> in alloc_strategy_ext) handles both cases in the original lDOS meaning,
    66                              <1> that is, as one area. Setting the flag 4 instead handles both cases as
    67                              <1> two areas. Flag 2 takes precedence if both are set. (This is handled in
    68                              <1> AllocateMCBCompatible, which calls AllocateLargestMCBRandom for the two
    69                              <1> area cases.)
    70                              <1> 
    71                              <1> --
    72                              <1> 
    73                              <1> When flag 1 of alloc_strategy_ext is set, the UMB link status (which
    74                              <1> here includes whether the last LMCB has an M or a Z) is ignored and
    75                              <1> the area flags of the allocation strategy are used exclusively.
    76                              <1> 
    77                              <1> %endif
    78                              <1> 
    79                              <1> %include "lmacros2.mac"
     1                              <2> [list -]
    80                              <1> %include "lstruct.mac"
     1                              <2> [list -]
    13                              <2> [list -]
    81                              <1> 
    82                              <1> 
    83                              <1> global GetMCBOwner, GetMCBFlags, GetRawMCBFlags, AllocateLargestMCBRandom
    84                              <1> global AllocateMCBCompatible.flags_cx
    85                              <1> global SplitMCB, ClearMCB
    86                              <1> 
    87                              <1> 
    88                              <1> 		; INP:	cx = user-requested flags
    89                              <1> 		; OUT:	cx = internally usable flags
    90                              <1> 		;	 (only one bit of bits 4..7 set, low nibble contains 0..2, high byte always clear)
    91                              <1> 		;	 word [ss:error_flags] updated
    92                              <1> 		; CHG:	-
    93                              <1> 		; STK:	4 word
    94                              <1> 		;
    95                              <1> 		; The user-requested flags are parsed to these internally used:
    96                              <1> 		; area:	10h LMA only
    97                              <1> 		;	20h LMA then UMA
    98                              <1> 		;	40h UMA only
    99                              <1> 		;	80h UMA then LMA
   100                              <1> 		;	(for the non-UMA build, all area flags are ignored and cleared)
   101                              <1> 		; mode:	00h First fit
   102                              <1> 		;	01h Best fit
   103                              <1> 		;	02h Last fit
   104                              <1> %ifn _UMA
   105                              <1> FixMCBFlags:
   106                              <1>  assume ds:nothing, es:nothing, ss:DOSGROUP
   107                              <1> 	test ch, ~(1 | 2 | 4)			; invalid flags set ?
   108                              <1> 	jz .validhigh
   109                              <1> 	and ch, (1 | 2 | 4)
   110                              <1> %if _ERRORFLAGS
   111                              <1> 	or byte [ss:error_flags], EF_InvalidAllocStrategy
   112                              <1> %endif
   113                              <1> .validhigh:
   114                              <1> 		; The problem arises that MS-DOS 5+ always supports
   115                              <1> 		; UMBs. Older versions allowed any value as strategy
   116                              <1> 		; using anything above 2 as "Last fit" too. Instead
   117                              <1> 		; of reproducing this behaviour, builds without UMA
   118                              <1> 		; fake that they actually support UMA but that there
   119                              <1> 		; was none installed. (After all, we use the DOS 5+
   120                              <1> 		; internal data layout.) Programs can check for this
   121                              <1> 		; fake support by calling 21.5802 and 21.5803. If UMA
   122                              <1> 		; is actually supported, 21.5802 always returns NC. If
   123                              <1> 		; UMA is not supported, it returns CY (ax = 0001h). If
   124                              <1> 		; UMA is supported, but not installed, 21.5803 still
   125                              <1> 		; returns CY (ax = 0001h).
   126                              <1> 	and cl, 0Fh				; clear area flags (we don't check these either)
   127                              <1> 	cmp cl, 3				; valid strategy ?
   128                              <1> 	jb .validstrategy			; yes -->
   129                              <1> 	xor cl, cl				; force first fit
   130                              <1> %if _ERRORFLAGS
   131                              <1> 	or byte [ss:error_flags], EF_InvalidAllocStrategy	; report invalid strategy
   132                              <1> %endif
   133                              <1> .validstrategy:
   134                              <1> 	retn
   135                              <1> %else
   136                              <1> FixMCBFlags:
   137                              <1>  assume ds:nothing, es:nothing, ss:DOSGROUP
   138 00000006 F6C5F8              <1> 	test ch, ~(1 | 2 | 4)			; invalid flags set ?
   139 00000009 7403                <1> 	jz .validhigh
   140 0000000B 80E507              <1> 	and ch, (1 | 2 | 4)
   141                              <1> %if _ERRORFLAGS
   142                              <1> 	or byte [ss:error_flags], EF_InvalidAllocStrategy
   143                              <1> %endif
   144                              <1> .validhigh:
   145 0000000E 50                  <1> 	 push ax
   146 0000000F 51                  <1> 	 push cx
   147 00000010 F6C1F0              <1> 	test cl, ~0Fh				; test whether any flag set
   148 00000013 7503                <1> 	jnz .gotflag
   149 00000015 80C920              <1> 	or cl, 20h				; "LMA then UMA" (if UMA enabled)
   150                              <1> .gotflag:
   151 00000018 B580                <1> 	mov ch, 80h
   152 0000001A F9                  <1> 	stc
   153 0000001B E81A00              <1> 	call .test
   154 0000001E E81700              <1> 	call .test
   155 00000021 E81400              <1> 	call .test				; (after this call, 10h is the only flag left. it is set)
   156                              <1> 
   157 00000024 30ED                <1> 	xor ch, ch				; insure high byte zero
   158 00000026 51                  <1> 	push cx
   159 00000027 80E10F              <1> 	and cl, 0Fh				; clear flags
   160 0000002A 80F903              <1> 	cmp cl, 3				; valid strategy ?
   161                              <1> 					; (0 = first fit, 1 = best fit, 2 = last fit)
   162 0000002D 59                  <1> 	pop cx
   163 0000002E 7203                <1> 	jb .validstrategy			; yes -->
   164 00000030 80E1F0              <1> 	and cl, ~0Fh				; force first fit
   165                              <1> %if _ERRORFLAGS
   166                              <1> 	or byte [ss:error_flags], EF_InvalidAllocStrategy	; invalid low nibble
   167                              <1> %endif
   168                              <1> .validstrategy:
   169 00000033 58                  <1> 	pop ax					; restore ch from stack into ah
   170 00000034 88E5                <1> 	mov ch, ah				; restore ch
   171 00000036 58                  <1> 	pop ax					; restore ax from stack
   172 00000037 C3                  <1> 	retn
   173                              <1> 
   174                              <1> .test:
   175 00000038 7307                <1> 	jnc .return				; previous call got flag
   176 0000003A 84E9                <1> 	test cl, ch				; current flag set ?
   177 0000003C 7504                <1> 	jnz .match				; yes -->
   178 0000003E D0ED                <1> 	shr ch, 1				; shift down
   179 00000040 F9                  <1> 	stc					; signal next calls to pass
   180                              <1> .return:
   181 00000041 C3                  <1> 	retn
   182                              <1> .match:
   183 00000042 30E9                <1> 	xor cl, ch				; clear flag itself
   184 00000044 F6C1F0              <1> 	test cl, ~0Fh				; any of the lower flags set ?
   185 00000047 7403                <1> 	jz .valid				; nope -->
   186 00000049 80E10F              <1> 	and cl, 0Fh				; clear lower flags
   187                              <1> %if _ERRORFLAGS
   188                              <1> 	or byte [ss:error_flags], EF_MultipleAllocAreas	; flag the error
   189                              <1> %endif
   190                              <1> .valid:
   191 0000004C 30E9                <1> 	xor cl, ch				; (NC) set flag again
   192 0000004E C3                  <1> 	retn
   193                              <1> 
   194                              <1> 
   195                              <1> 		; Compare ax to first UMCB
   196                              <1> 		;
   197                              <1> 		; INP:	ax = MCB
   198                              <1> 		; OUT:	NZ if not first UMCB (or if there's no UMCB)
   199                              <1> 		;	ZR if first UMCB
   200                              <1> 		; CHG:	-
   201                              <1> 		; STK:	1 word
   202                              <1> IsFirstUMCB?:
   203                              <1>  assume ds:nothing, es:nothing, ss:DOSGROUP
   204 0000004F 36833E[0000]FE      <1> 	cmp word [ss:first_umcb], byte -2
   205 00000055 7705                <1> 	ja .return			; (NZ if it jumps) -->
   206 00000057 363B06[0000]        <1> 	cmp ax, word [ss:first_umcb]
   207                              <1> .return:
   208 0000005C C3                  <1> 	retn
   209                              <1> 
   210                              <1> 
   211                              <1> GetRawMCBFlags:
   212                              <1>  assume ds:nothing, es:nothing, ss:DOSGROUP
   213 0000005D 368A2E[0000]        <1> 	mov ch, byte [ss:alloc_strategy_ext]
   214 00000062 368A0E[0000]        <1> 	mov cl, byte [ss:AllocMethod]	; cx = flags
   215 00000067 C3                  <1> 	retn
   216                              <1> 
   217                              <1> 
   218                              <1> 		; Get current MCB flags
   219                              <1> 		;
   220                              <1> 		; INP:	-
   221                              <1> 		; OUT:	cx = internally usable flags
   222                              <1> 		;	 (only one bit of bits 4..7 set, low nibble contains 0..2, high byte always clear)
   223                              <1> 		;	 error_flags updated
   224                              <1> 		; CHG:	-
   225                              <1> 		; STK:	3 word
   226                              <1> GetMCBFlags:
   227                              <1>  assume ds:nothing, es:nothing, ss:DOSGROUP
   228 00000068 E8F2FF              <1> 	call GetRawMCBFlags
   229 0000006B E898FF              <1> 	call FixMCBFlags			; detect multiple area flags
   230                              <1> %if _ERRORFLAGS
   231                              <1> 	test byte [ss:enable_uma], ~1
   232                              <1> 	jz .validlink
   233                              <1> 	or byte [ss:error_flags], EF_InvalidUMBLink	; invalid UMB link bits set
   234                              <1> .validlink:
   235                              <1> %endif
   236 0000006E F6C501              <1> 	test ch, 1				; use area flags and
   237                              <1> 						;  disregard UMB link ?
   238 00000071 7516                <1> 	jnz .return				; yes -->
   239 00000073 36F606[0000]01      <1> 	test byte [ss:enable_uma], 1		; UMA enabled ?
   240 00000079 7408                <1> 	jz .lmaonly				; no, force LMA only --> (no error flag)
   241 0000007B 36833E[0000]FF      <1> 	cmp word [ss:first_umcb], byte -1	; UMA available ?
   242 00000081 7506                <1> 	jne .return
   243                              <1> %if _ERRORFLAGS
   244                              <1> 	or byte [ss:error_flags], EF_NoUMBsToLink	; UMB link enabled but none there
   245                              <1> %endif
   246                              <1> .lmaonly:					; change area to LMA only
   247 00000083 80E10F              <1> 	and cl, 0Fh
   248 00000086 80C910              <1> 	or cl, 10h
   249                              <1> .return:
   250 00000089 C3                  <1> 	retn
   251                              <1> %endif
   252                              <1> 
   253                              <1> 
   254                              <1> 		; Set MCB flags for linear access
   255                              <1> 		;  ("LMA only" if no UMA available, else "LMA then UMA")
   256                              <1> 		;
   257                              <1> 		; INP:	-
   258                              <1> 		; OUT:	ax = 0000h (to get first MCB on SNextMCB call)
   259                              <1> 		;	ss:sp-> flags (word 10h if no first UMCB, 20h else),
   260                              <1> 		;		loop detection counter (word initialised to 0),
   261                              <1> 		;		original si value
   262                              <1> 		;	ss:si-> flags (si = sp)
   263                              <1> 		;	NC, ZR
   264                              <1> 		; CHG:	-
   265                              <1> 		; STK:	5 word
   266                              <1> SetLinearMCBFlags:
   267                              <1>  assume ds:nothing, es:nothing, ss:DOSGROUP
   268 0000008A 55                  <1> 	push bp
   269 0000008B 89E5                <1> 	mov bp, sp
   270 0000008D B81000              <1> 	mov ax, 10h				; if no UMCB, set to 10h ("LMA only")
   271                              <1> %if _UMA
   272 00000090 36833E[0000]FF      <1> 	cmp word [ss:first_umcb], -1
   273 00000096 7402                <1> 	je .nonuma
   274 00000098 B020                <1> 	mov al, 20h				; else set to 20h ("LMA then UMA")
   275                              <1> .nonuma:
   276                              <1> %endif
   277 0000009A 50                  <1> 	push ax					; flags word, at [bp - 2]
   278 0000009B FF7602              <1> 	push word [bp + 2]			; create return stack space, ip
   279 0000009E FF7600              <1> 	push word [bp]				; bp on stack
   280 000000A1 31C0                <1> 	xor ax, ax
   281 000000A3 897602              <1> 	mov word [bp + 2], si			; save si value on stack
   282 000000A6 894600              <1> 	mov word [bp], ax			; loop detection counter
   283 000000A9 8D76FE              <1> 	lea si, [bp - 2]			; ss:si-> flags
   284 000000AC 5D                  <1> 	pop bp					; bp = [bp - 6]
   285 000000AD C3                  <1> 	retn					; ip = [bp - 4]
   286                              <1> 
   287                              <1> 
   288                              <1> 		; Get current MCB owner
   289                              <1> 		;
   290                              <1> 		; INP:	-
   291                              <1> 		; OUT:	dx = PSP address or owner override value
   292                              <1> 		; CHG:	-
   293                              <1> 		; STK:	2 word
   294                              <1> GetMCBOwner:
   295                              <1>  assume ds:nothing, es:nothing, ss:DOSGROUP
   296 000000AE 87D3                <1> 	xchg dx, bx
   297                              <1> %if 0
   298                              <1> 	mov bx, word [ss:current_driver]
   299                              <1> 	inc bx
   300                              <1> 	jz .usepsp				; was FFFFh, override inactive -->
   301                              <1> 	dec bx
   302                              <1> 	jnz .override				; was not 0000h, override active -->
   303                              <1> %endif
   304                              <1> .usepsp:
   305 000000B0 E84DFF              <1> 	call getpsp				; don't care which value returned
   306 000000B3 85DB                <1> 	test bx, bx
   307 000000B5 7501                <1> 	jnz .return
   308 000000B7 43                  <1> 	inc bx					; except, not zero !
   309                              <1> .override:
   310                              <1> .return:
   311 000000B8 87D3                <1> 	xchg dx, bx
   312 000000BA C3                  <1> 	retn
   313                              <1> 
   314                              <1> 
   315                              <1> 		; Verify MCB
   316                              <1> 		;
   317                              <1> 		; INP:	ax = MCB
   318                              <1> 		; OUT:	ds = MCB
   319                              <1> 		;	di = 0
   320                              <1> 		;	NZ, CY if invalid MCB,
   321                              <1> 		;	 ax = error code 0007h (MCB chain corrupted)
   322                              <1> 		;	ZR, NC if valid MCB
   323                              <1> 		; CHG:	-
   324                              <1> 		; STK:	1 word
   325                              <1> VerifyMCB:
   326                              <1>  assume ds:nothing, es:nothing, ss:nothing
   327 000000BB 31FF                <1> 	xor di, di
   328 000000BD 8ED8                <1> 	mov ds, ax				; set up working registers
   329                              <1>  assume ds:nothing
   330 000000BF 40                  <1> 	inc ax
   331 000000C0 83F802              <1> 	cmp ax, byte 2				; passed value FFFFh or 0000h ?
   332 000000C3 720B                <1> 	jb .invalid				; (NZ, CY) yes -->
   333 000000C5 48                  <1> 	dec ax
   334                              <1>  assume ds:MCB
   335 000000C6 803D4D              <1> 	cmp byte [di+mcbSignature], 'M'		; valid 'M' signature ?
   336 000000C9 7409                <1> 	je .return				; yes --> (ZR, NC)
   337 000000CB 803D5A              <1> 	cmp byte [di+mcbSignature], 'Z'		; valid 'Z' signature ?
   338 000000CE 7404                <1> 	je .return				; yes --> (ZR, NC)
   339                              <1> .invalid:
   340 000000D0 F9                  <1> 	stc
   341 000000D1 B80700              <1> 	mov ax, errorMCBDestroyed		; (CY, NZ) else invalid
   342                              <1> .return:
   343 000000D4 C3                  <1> 	retn
   344                              <1> 
   345                              <1> 
   346                              <1> 		; INP:	ax = memory block's segment
   347                              <1> 		; OUT:	di = 0
   348                              <1> 		;	NC if valid MCB,
   349                              <1> 		;	 ds = ax = MCB address
   350                              <1> 		;	CY if invalid MCB,
   351                              <1> 		;	 ax = error code 0009h (Invalid MCB)
   352                              <1> 		; CHG:	ds
   353                              <1> 		; STK:	2 word
   354                              <1> GetMCBFromBlock:
   355                              <1>  assume ds:nothing, es:nothing, ss:nothing
   356 000000D5 48                  <1> 	dec ax
   357                              <1> 
   358                              <1> 		; Besides checking the signature, we don't do anything here.
   359                              <1> 		; We could walk the actual chain to insure that MCB is on it,
   360                              <1> 		; but that would prohibit freeing or resizing blocks in the
   361                              <1> 		; excluded UMA sub-chains. (As I verified once with my
   362                              <1> 		; horrible DEBUG preloading device driver hack, the usage of
   363                              <1> 		; independant sub-chains isn't prohibited by MS-DOS.)
   364                              <1> 
   365                              <1> 		; Verify MCB, different error code
   366                              <1> 		;
   367                              <1> 		; INP:	ax = MCB
   368                              <1> 		; OUT:	ds = MCB
   369                              <1> 		;	di = 0
   370                              <1> 		;	NZ, CY if invalid MCB,
   371                              <1> 		;	 ax = error code 0009h (Invalid MCB)
   372                              <1> 		;	ZR, NC if valid MCB
   373                              <1> 		; CHG:	-
   374                              <1> 		; STK:	2 word
   375                              <1> VerifySingleMCB:
   376                              <1>  assume ds:nothing, es:nothing, ss:nothing
   377 000000D6 E8E2FF              <1> 	call VerifyMCB
   378 000000D9 7303                <1> 	jnc .return
   379 000000DB B80900              <1> 	mov ax, errorMCBInvalid
   380                              <1> .return:
   381 000000DE C3                  <1> 	retn
   382                              <1> 
   383                              <1> 
   384                              <1> 		; Clear MCB owner and name, or name only
   385                              <1> 		;
   386                              <1> 		; INP:	ds = MCB
   387                              <1> 		;	di = 0
   388                              <1> 		; OUT:	-
   389                              <1> 		; CHG:	- (CF is preserved too)
   390                              <1> 		; STK:	1 word
   391                              <1> 		; STT:	ss need not equal DOSDATA
   392                              <1> ClearMCB:
   393                              <1>  assume ds:MCB, es:nothing, ss:nothing
   394 000000DF 897D01              <1> 	mov word [di+mcbOwner], di		; free up block
   395                              <1> ClearMCBName:
   396                              <1>  assume ds:MCB, es:nothing, ss:nothing
   397 000000E2 897D08              <1> 	mov word [di+mcbName+0], di
   398 000000E5 897D0A              <1> 	mov word [di+mcbName+2], di
   399 000000E8 897D0C              <1> 	mov word [di+mcbName+4], di
   400 000000EB 897D0E              <1> 	mov word [di+mcbName+6], di		; clear the name field
   401 000000EE C3                  <1> 	retn
   402                              <1> 
   403                              <1> 
   404                              <1> 		; Release MCB
   405                              <1> 		;
   406                              <1> 		; INP:	ax = memory block's segment
   407                              <1> 		; OUT:	CY if invalid MCB,
   408                              <1> 		;	 ax = error code
   409                              <1> 		;	NC if valid MCB, released,
   410                              <1> 		;	 ax = MCB
   411                              <1> 		; CHG:	ax
   412                              <1> 		;
   413                              <1> 		; DOS should not collect MCBs after freeing. This can
   414                              <1> 		; break software which directly modifies MCBs because
   415                              <1> 		; the software may think the MCB still exists there.
   416                              <1> 		; ecm 2026: Added option to collect MCBs after freeing.
   417                              <1> ReleaseMCB:
   418                              <1>  assume ds:nothing, es:nothing, ss:nothing
   419 000000EF 1E                  <1> 	push ds
   420 000000F0 57                  <1> 	push di
   421 000000F1 E8E1FF              <1> 	call GetMCBFromBlock			; get MCB from block address
   422 000000F4 7220                <1> 	jc .ret					; invalid address or signature -->
   423                              <1>  assume ds:MCB
   424 000000F6 E8E6FF              <1> 	call ClearMCB				; free it
   425                              <1>  assume ds:nothing
   426                              <1> 
   427 000000F9 36D006[0100]        <1> 	rol byte [ss:config_collect_free_mcb], 1
   428 000000FE 7316                <1> 	jnc .ret				; --> (NC)
   429 00000100 E887FF              <1> 	call SetLinearMCBFlags			; set order for accessing all MCBs
   430 00000103 8CD8                <1> 	mov ax, ds
   431                              <1> .again:
   432 00000105 E82C01              <1> 	call CollectNextFreeMCB			; merge next with this one, if free
   433 00000108 73FB                <1> 	jnc .again				; merged, check if next also free -->
   434 0000010A 83F808              <1> 	cmp ax, errorInsufficientMemory		; was error "Not enough memory" ?
   435 0000010D 7503                <1> 	jne .collecterror
   436 0000010F 8CD8                <1> 	mov ax, ds
   437 00000111 A8                  <1> 	db __TEST_IMM8				; skip stc, NC
   438                              <1> .collecterror:
   439 00000112 F9                  <1> 	stc
   440 00000113 5E                  <1> 	pop si					; discard flags word
   441 00000114 5E                  <1> 	pop si					; discard loop counter word
   442 00000115 5E                  <1> 	pop si
   443                              <1> 
   444                              <1> .ret:
   445                              <1>  assume ds:nothing
   446 00000116 5F                  <1> 	pop di
   447 00000117 1F                  <1> 	pop ds
   448                              <1>  assume ds:nothing
   449 00000118 C3                  <1> 	retn
   450                              <1> 
   451                              <1> 
   452                              <1> 		; Get next MCB, insuring the chain doesn't loop
   453                              <1> 		;
   454                              <1> 		; INP:	word [ss:si] = area flags and allocation strategy
   455                              <1> 		;	word [ss:si + 2] = loop detection counter, init to 0
   456                              <1> 		;	ax = former MCB (0000h to get first)
   457                              <1> 		; OUT:	CY if MCB chain corrupted or loops,
   458                              <1> 		;	 ax = error code
   459                              <1> 		;	NC if MCB chain intact,
   460                              <1> 		;	 NZ if no next MCB,
   461                              <1> 		;	  ax = error code (0008h)
   462                              <1> 		;	 ZR if next MCB available,
   463                              <1> 		;	  ax = next MCB
   464                              <1> 		;	di = 0
   465                              <1> 		; CHG:	-
   466                              <1> 		; STK:	8 word
   467                              <1> ;	doscode_insure_low_byte_not_0CCh
   468                              <1> SNextMCB:
   469                              <1>  assume ds:nothing, es:nothing, ss:DOSGROUP
   470 00000119 31FF                <1> 	xor di, di
   471 0000011B 36FF4C02            <1> 	dec word [ss:si + 2]
   472 0000011F 7508                <1> 	jnz @F
   473                              <1> 		; This doesn't branch if ZR, meaning if the 1_0000h iterations
   474                              <1> 		;  have run out (if counter was 1 prior to the dec).
   475 00000121 1E                  <1> 	push ds
   476 00000122 8ED8                <1> 	mov ds, ax
   477 00000124 B8FE00              <1> 	mov ax, errorMCBLoops
   478 00000127 EB53                <1> 	jmp NextMCB.error
   479                              <1> 
   480                              <1> @@:
   481                              <1> 		; (fall through to NextMCB)
   482                              <1> 
   483                              <1> 
   484                              <1> 		; Get next MCB
   485                              <1> 		;
   486                              <1> 		; INP:	word [ss:si] = area flags and allocation strategy
   487                              <1> 		;	word [ss:si + 2] = loop detection counter
   488                              <1> 		;	ax = former MCB (0000h to get first)
   489                              <1> 		; OUT:	CY if MCB chain corrupted,
   490                              <1> 		;	 ax = error code
   491                              <1> 		;	NC if MCB chain intact,
   492                              <1> 		;	 NZ if no next MCB,
   493                              <1> 		;	  ax = error code 0008h (Not enough memory)
   494                              <1> 		;	 ZR if next MCB available,
   495                              <1> 		;	  ax = next MCB
   496                              <1> 		;	di = 0
   497                              <1> 		; CHG:	-
   498                              <1> 		; STK:	3 word
   499                              <1> 		;
   500                              <1> 		; An interesting effect of how this code handles the first UMCB
   501                              <1> 		; is that it doesn't care whether the previous MCB contains an
   502                              <1> 		; 'M' (normal MCB chain extended into UMA) or 'Z' (normal MCB
   503                              <1> 		; chain limited to LMA). Also, the parsed area flags allow to
   504                              <1> 		; ignore the actual requested UMB link: If it was zero, all
   505                              <1> 		; area flags are cleared and forced to 10h (LMA only) instead.
   506                              <1> %ifn _UMA
   507                              <1> NextMCB:
   508                              <1>  assume ds:nothing, es:nothing, ss:DOSGROUP
   509                              <1> 	push ds
   510                              <1> 	test ax, ax				; request for first ?
   511                              <1> 	jz .first				; yes -->
   512                              <1> 
   513                              <1> 	call VerifyMCB				; check input MCB first
   514                              <1> 	jc .return
   515                              <1>  assume ds:MCB
   516                              <1> 	inc ax
   517                              <1> 	add ax, word [di+mcbSize]		; get address of next (if any)
   518                              <1> 	cmp byte [di+mcbSignature], 'M'		; current in-chain ?
   519                              <1> 	je .verify				; yes, verify it -->
   520                              <1> 		; If this was NZ and didn't jump, then the mcbSignature
   521                              <1> 		;  contains the letter 'Z', which is above 'M'. Therefore,
   522                              <1> 		;  it is always true that it is NC at this point.
   523                              <1> 	mov ax, errorInsufficientMemory		; (NC, NZ)
   524                              <1> 	pop ds
   525                              <1>  assume ds:nothing
   526                              <1> 	retn
   527                              <1> .first:
   528                              <1> 	mov ax, word [ss:first_mcb]
   529                              <1> .verify:
   530                              <1>  assume ds:MCB
   531                              <1> 	call VerifyMCB				; NC, ZR if valid - CY if invalid
   532                              <1> .return:
   533                              <1> 	pop ds
   534                              <1>  assume ds:nothing
   535                              <1> 	retn
   536                              <1> %else
   537                              <1> 		; The UMA build has to evaluate the (parsed) area flags
   538                              <1> 		; here to show the caller a continuous chain of MCBs.
   539                              <1> 		; This requires special handling in two cases: If the
   540                              <1> 		; caller's input was 0000h (to get the first MCB) or if
   541                              <1> 		; it was the MCB before the first UMCB. Area flags of
   542                              <1> 		; 80h and 40h want to start their search with the first
   543                              <1> 		; UMCB instead. Flags 20h want to proceed at the first
   544                              <1> 		; UMCB, all other flags want to stop there. The first
   545                              <1> 		; UMCB's handling ignores whether the preceeding MCB
   546                              <1> 		; contained 'M' or 'Z'.
   547                              <1> NextMCB:
   548                              <1>  assume ds:nothing, es:nothing, ss:DOSGROUP
   549 00000129 1E                  <1> 	push ds
   550 0000012A 85C0                <1> 	test ax, ax				; request for first ?
   551 0000012C 7432                <1> 	jz .first				; yes -->
   552                              <1> 
   553 0000012E E88AFF              <1> 	call VerifyMCB				; check input MCB first
   554 00000131 7249                <1> 	jc .error
   555                              <1>  assume ds:MCB
   556 00000133 36A3[0000]          <1> 	mov word [ss:nextmcbinput], ax
   557 00000137 40                  <1> 	inc ax
   558 00000138 034503              <1> 	add ax, word [di+mcbSize]		; get address of next (whether current is 'M' or 'Z')
   559                              <1> 
   560 0000013B E811FF              <1> 	call IsFirstUMCB?			; is the one behind this the first UMCB ?
   561 0000013E 7508                <1> 	jne .notfirstumcb			; nope, check if last -->
   562 00000140 36F604D0            <1> 	test byte [ss:si], ~2Fh			; "LMA then UMA" ?
   563                              <1> 		; x = D0h --> x & ~20h != 00h if area other than LMA-then-UMA,
   564                              <1> 		; x = 20h --> x & ~20h = 00h if area is LMA-then-UMA
   565 00000144 7431                <1> 	jz .verify				; yes, proceed here -->
   566                              <1> 		; After test, it is always NC here.
   567 00000146 EB13                <1> 	jmp short .last				; (NC, NZ) else it's the last one (even if 'M') -->
   568                              <1> .notfirstumcb:
   569 00000148 803D4D              <1> 	cmp byte [di+mcbSignature], 'M'		; current in-chain ?
   570 0000014B 742A                <1> 	je .verify				; no -->
   571 0000014D 36833E[0000]FE      <1> 	cmp word [ss:first_umcb], byte -2	; any UMA ?
   572 00000153 7706                <1> 	ja .last				; (NC, NZ) no, really last -->
   573 00000155 36F60470            <1> 	test byte [ss:si], ~8Fh			; "UMA then LMA" ?
   574                              <1> 		; x = 70h --> x & ~80h != 00h if area other than UMA-then-LMA,
   575                              <1> 		; x = 80h --> x & ~80h = 00h if area is UMA-then-LMA
   576 00000159 7418                <1> 	jz .firstlma				; yes, start to search LMA instead -->
   577                              <1> 		; After test, it is always NC here.
   578                              <1> .last:
   579 0000015B B80800              <1> 	mov ax, errorInsufficientMemory		; (NC, NZ)
   580 0000015E 1F                  <1> 	pop ds
   581                              <1>  assume ds:nothing
   582 0000015F C3                  <1> 	retn
   583                              <1> .first:
   584 00000160 36A3[0000]          <1> 	mov word [ss:nextmcbinput], ax
   585 00000164 36F604C0            <1> 	test byte [ss:si], (80h|40h)		; "UMA then LMA" or "UMA only" ?
   586 00000168 7409                <1> 	jz .firstlma				; no, start with LMA -->
   587 0000016A 36A1[0000]          <1> 	mov ax, word [ss:first_umcb]		; yes, start with UMA
   588 0000016E 83F8FF              <1> 	cmp ax, -1				; UMA valid ?
   589 00000171 7504                <1> 	jne .verify				; yes -->
   590                              <1> .firstlma:
   591 00000173 36A1[0000]          <1> 	mov ax, word [ss:first_mcb]		; start with LMA
   592                              <1> .verify:
   593                              <1>  assume ds:MCB
   594 00000177 E841FF              <1> 	call VerifyMCB				; NC, ZR if valid - CY if invalid
   595 0000017A 7335                <1> 	jnc .return
   596                              <1> .error:
   597                              <1>  extern doscode_halt_query
   598                              <1>  extern doscode_disp_msg_cs
   599                              <1>  extern doscode_disp_al
   600                              <1>  extern doscode_disp_al_hex
   601                              <1>  extern doscode_disp_ax_hex
   602                              <1>  extern doscode_disp_blank
   603                              <1>  extern doscode_msg.mcb.1
   604                              <1>  extern doscode_msg.mcb.2
   605                              <1>  extern doscode_msg.mcb.3
   606                              <1>  extern doscode_msg.mcb.4
   607                              <1>  extern doscode_msg.mcb.first
   608                              <1>  extern doscode_msg.empty
   609                              <1>  extern doscode_msg.error_common
   610                              <1>  extern doscode_msg.crlf
   611                              <1>  extern nextmcbinput
   612                              <1> 
   613 0000017C 56                  <1> 	push si
   614 0000017D 50                  <1> 	push ax
   615 0000017E BE[0000]            <1> 	mov si, doscode_msg.error_common	; access with cs
   616 00000181 E8(0000)            <1> 	call doscode_disp_msg_cs
   617 00000184 BE[0000]            <1> 	mov si, doscode_msg.mcb.1
   618 00000187 E8(0000)            <1> 	call doscode_disp_msg_cs
   619 0000018A E8(0000)            <1> 	call doscode_disp_al_hex
   620 0000018D BE[0000]            <1> 	mov si, doscode_msg.mcb.2
   621 00000190 E8(0000)            <1> 	call doscode_disp_msg_cs
   622 00000193 36A1[0000]          <1> 	mov ax, word [ss:nextmcbinput]
   623 00000197 E81900              <1> 	call DumpMCB
   624 0000019A BE[0000]            <1> 	mov si, doscode_msg.mcb.3
   625 0000019D E8(0000)            <1> 	call doscode_disp_msg_cs
   626 000001A0 8CD8                <1> 	mov ax, ds
   627 000001A2 E80E00              <1> 	call DumpMCB
   628 000001A5 BE[0000]            <1> 	mov si, doscode_msg.empty
   629                              <1>  extern flag_no_halt_mcb
   630 000001A8 B8[0000]            <1> 	mov ax, flag_no_halt_mcb
   631 000001AB E8(0000)            <1> 	call doscode_halt_query
   632 000001AE 58                  <1> 	pop ax
   633 000001AF 5E                  <1> 	pop si
   634 000001B0 F9                  <1> 	stc
   635                              <1> .return:
   636 000001B1 1F                  <1> 	pop ds
   637                              <1>  assume ds:nothing
   638 000001B2 C3                  <1> 	retn
   639                              <1> %endif
   640                              <1> 
   641                              <1> 
   642                              <1> DumpMCB:
   643 000001B3 1E                  <1> 	push ds
   644 000001B4 51                  <1> 	push cx
   645 000001B5 E8(0000)            <1> 	call doscode_disp_ax_hex
   646 000001B8 BE[0000]            <1> 	mov si, doscode_msg.mcb.first
   647 000001BB 85C0                <1> 	test ax, ax
   648 000001BD 7451                <1> 	jz .end
   649 000001BF 8ED8                <1> 	mov ds, ax
   650 000001C1 31F6                <1> 	xor si, si
   651 000001C3 E8(0000)            <1> 	call doscode_disp_blank
   652 000001C6 AC                  <1> 	lodsb			; sign
   653 000001C7 E8(0000)            <1> 	call doscode_disp_al_hex
   654 000001CA E8(0000)            <1> 	call doscode_disp_blank
   655 000001CD E8(0000)            <1> 	call doscode_disp_blank
   656 000001D0 B90200              <1> 	mov cx, 2
   657                              <1> @@:
   658 000001D3 AD                  <1> 	lodsw			; owner, size
   659 000001D4 E8(0000)            <1> 	call doscode_disp_ax_hex
   660 000001D7 E8(0000)            <1> 	call doscode_disp_blank
   661 000001DA E2F7                <1> 	loop @B
   662 000001DC E8(0000)            <1> 	call doscode_disp_blank
   663 000001DF B103                <1> 	mov cl, 3
   664                              <1> @@:
   665 000001E1 AC                  <1> 	lodsb			; reserved
   666 000001E2 E8(0000)            <1> 	call doscode_disp_al_hex
   667 000001E5 E8(0000)            <1> 	call doscode_disp_blank
   668 000001E8 E2F7                <1> 	loop @B
   669 000001EA E8(0000)            <1> 	call doscode_disp_blank
   670 000001ED B108                <1> 	mov cl, 8
   671                              <1> @@:
   672 000001EF AC                  <1> 	lodsb			; name
   673 000001F0 E8(0000)            <1> 	call doscode_disp_al_hex
   674 000001F3 E8(0000)            <1> 	call doscode_disp_blank
   675 000001F6 E2F7                <1> 	loop @B
   676                              <1> 
   677 000001F8 B108                <1> 	mov cl, 8
   678 000001FA 89CE                <1> 	mov si, cx
   679 000001FC B022                <1> 	mov al, '"'
   680 000001FE E8(0000)            <1> 	call doscode_disp_al
   681                              <1> @@:
   682 00000201 AC                  <1> 	lodsb			; name
   683 00000202 40                  <1> 	inc ax			; 7Fh to 80h, 20h to 21h
   684 00000203 3C20                <1> 	cmp al, 32		; 80h..FFh..20h ?
   685 00000205 7E06                <1> 	jle @F			; yes, non-printable-ASCII, end -->
   686 00000207 48                  <1> 	dec ax			; restore
   687 00000208 E8(0000)            <1> 	call doscode_disp_al
   688 0000020B E2F4                <1> 	loop @B
   689                              <1> @@:
   690 0000020D BE[0000]            <1> 	mov si, doscode_msg.mcb.4
   691                              <1> .end:
   692 00000210 E8(0000)            <1> 	call doscode_disp_msg_cs
   693 00000213 59                  <1> 	pop cx
   694 00000214 1F                  <1> 	pop ds
   695 00000215 C3                  <1> 	retn
   696                              <1> 
   697                              <1> 
   698                              <1> 		; Release all memory of a specific owner
   699                              <1> 		;
   700                              <1> 		; INP:	bx = MCB owner of which blocks are to be freed
   701                              <1> 		; OUT:	CY if MCB chain corrupted or loops,
   702                              <1> 		;	 ax = error code
   703                              <1> 		;	NC if MCB chain valid
   704                              <1> 		; CHG:	ax
   705                              <1> 		; STK:	13 word
   706                              <1> ReleaseOwnersMCBs:
   707                              <1>  assume ds:nothing, es:nothing, ss:DOSGROUP
   708 00000216 1E                  <1> 	push ds
   709 00000217 57                  <1> 	push di
   710 00000218 E86FFE              <1> 	call SetLinearMCBFlags			; set order for accessing all MCBs
   711                              <1> .loop:
   712                              <1>  assume ds:nothing
   713 0000021B E8FBFE              <1> 	call SNextMCB				; ax = MCB
   714 0000021E 720E                <1> 	jc .return
   715 00000220 750C                <1> 	jne .return
   716 00000222 8ED8                <1> 	mov ds, ax				; ds = MCB
   717                              <1>  assume ds:MCB
   718 00000224 395D01              <1> 	cmp word [di+mcbOwner], bx		; does block belong to owner ?
   719 00000227 75F2                <1> 	jne .loop				; no -->
   720 00000229 E8B3FE              <1> 	call ClearMCB				; free up block
   721 0000022C EBED                <1> 	jmp short .loop
   722                              <1> .return:
   723 0000022E 5E                  <1> 	pop si					; discard flags word
   724 0000022F 5E                  <1> 	pop si					; discard loop counter word
   725 00000230 5E                  <1> 	pop si
   726 00000231 5F                  <1> 	pop di
   727 00000232 1F                  <1> 	pop ds
   728                              <1>  assume ds:nothing
   729 00000233 C3                  <1> 	retn
   730                              <1> 
   731                              <1> 
   732                              <1> 		; Merge MCB with next one if possible
   733                              <1> 		;
   734                              <1> 		; INP:	ds = ax = MCB
   735                              <1> 		;	word [ss:si] = 20h/10h (linear MCB flag setting)
   736                              <1> 		;	word [ss:si + 2] = loop detection counter
   737                              <1> 		; OUT:	CY if invalid MCB,
   738                              <1> 		;	 ax = error code
   739                              <1> 		;	CY if no next MCB or next MCB is not free,
   740                              <1> 		;	 ax = errorInsufficientMemory
   741                              <1> 		;	NC if valid next MCB was free, merged
   742                              <1> 		;	di = 0
   743                              <1> 		; CHG:	-
   744                              <1> 		; STK:	10 word
   745                              <1> CollectNextFreeMCB:
   746                              <1>  assume ds:MCB, es:nothing, ss:DOSGROUP
   747 00000234 06                  <1> 	push es
   748 00000235 E8E1FE              <1> 	call SNextMCB
   749 00000238 721F                <1> 	jc .return
   750 0000023A 751F                <1> 	jne .notenough				; at last block, can't expand -->
   751                              <1> %if _UMA
   752 0000023C E810FE              <1> 	call IsFirstUMCB?			; next is first UMCB ?
   753 0000023F 741A                <1> 	je .notenough				; yes, can't expand -->
   754                              <1> %endif
   755 00000241 8EC0                <1> 	mov es, ax				; address of next block
   756                              <1>  assume es:MCB
   757 00000243 26397D01            <1> 	cmp word [es:di+mcbOwner], di		; is next block free ?
   758 00000247 7512                <1> 	jne .notenough				; no, can't expand -->
   759                              <1> 
   760 00000249 268A05              <1> 	mov al, byte [es:di+mcbSignature]	; get letter of next MCB
   761 0000024C 8805                <1> 	mov byte [di+mcbSignature], al		; adjust letter of MCB if next was 'Z'
   762 0000024E 268B4503            <1> 	mov ax, word [es:di+mcbSize]
   763 00000252 40                  <1> 	inc ax					; get size of next MCB (including the MCB)
   764 00000253 014503              <1> 	add word [di+mcbSize], ax		; expand MCB
   765                              <1>  assume es:nothing
   766 00000256 8CD8                <1> 	mov ax, ds
   767 00000258 F8                  <1> 	clc
   768                              <1> .return:
   769 00000259 07                  <1> 	pop es
   770                              <1>  assume es:nothing
   771 0000025A C3                  <1> 	retn
   772                              <1> 
   773                              <1> .notenough:
   774                              <1>  assume es:nothing
   775 0000025B F9                  <1> 	stc
   776 0000025C B80800              <1> 	mov ax, errorInsufficientMemory
   777 0000025F 07                  <1> 	pop es
   778                              <1>  assume es:nothing
   779 00000260 C3                  <1> 	retn
   780                              <1> 
   781                              <1> 
   782                              <1> 		; Collect free MCBs
   783                              <1> 		;
   784                              <1> 		; INP:	-
   785                              <1> 		; OUT:	CY if MCB chain corrupted or loops,
   786                              <1> 		;	 ax = error code
   787                              <1> 		;	NC if valid
   788                              <1> 		; CHG:	ax
   789                              <1> 		; STK:	15 word
   790                              <1> 		;
   791                              <1> 		; Scans all MCBs and merges free ones together.
   792                              <1> CollectFreeMCBs:
   793                              <1>  assume ds:nothing, es:nothing, ss:DOSGROUP
   794 00000261 1E                  <1> 	push ds
   795 00000262 57                  <1> 	push di
   796 00000263 E824FE              <1> 	call SetLinearMCBFlags			; set order for accessing all MCBs
   797                              <1> .loop:
   798                              <1>  assume ds:nothing
   799 00000266 E8B0FE              <1> 	call SNextMCB				; ax = next MCB
   800 00000269 7218                <1> 	jc .return				; chain corrupted -->
   801 0000026B 7516                <1> 	jne .return				; no next -->
   802                              <1> .check:
   803 0000026D 8ED8                <1> 	mov ds, ax				; ds = MCB
   804                              <1>  assume ds:MCB
   805 0000026F 397D01              <1> 	cmp word [di+mcbOwner], di		; is block free ?
   806 00000272 75F2                <1> 	jne .loop				; no, try next -->
   807                              <1> .again:
   808 00000274 E8BDFF              <1> 	call CollectNextFreeMCB			; merge next with this one, if free
   809 00000277 73FB                <1> 	jnc .again				; merged, check if next also free -->
   810 00000279 83F808              <1> 	cmp ax, errorInsufficientMemory		; was error "Not enough memory" ?
   811 0000027C F9                  <1> 	stc
   812 0000027D 7504                <1> 	jne .return				; no, real error -->
   813 0000027F 8CD8                <1> 	mov ax, ds
   814 00000281 EBE3                <1> 	jmp short .loop				; try next block --> (SNextMCB reports if current was last)
   815                              <1> .return:
   816 00000283 5E                  <1> 	pop si					; discard flags word
   817 00000284 5E                  <1> 	pop si					; discard loop counter word
   818 00000285 5E                  <1> 	pop si
   819 00000286 5F                  <1> 	pop di
   820 00000287 1F                  <1> 	pop ds
   821                              <1>  assume ds:nothing
   822 00000288 C3                  <1> 	retn
   823                              <1> 
   824                              <1> 
   825                              <1> 		; Split one MCB into two smaller MCBs
   826                              <1> 		;
   827                              <1> 		; INP:	ds = ax = MCB
   828                              <1> 		;	di = 0
   829                              <1> 		;	cx = requested size of existing MCB
   830                              <1> 		;		(the MCB *MUST* be larger currently)
   831                              <1> 		;	dx = requested owner of new MCB
   832                              <1> 		; OUT:	dx = created new MCB (at ax+cx+1)
   833                              <1> 		;	NC if valid input
   834                              <1> 		;	CY if MCB size is smaller than or equal to cx,
   835                              <1> 		;	 ax = error code (errorMCBDestroyed)
   836                              <1> 		; CHG:	cx
   837                              <1> 		; STK:	5 word
   838                              <1> 		; STT:	ss need not equal DOSDATA
   839                              <1> 		;
   840                              <1> 		; Interestingly, this is the only code to create new MCBs.
   841                              <1> 		; Functions not calling this code simply re-use existing MCBs.
   842                              <1> SplitMCB:
   843                              <1>  assume ds:MCB, es:nothing, ss:nothing
   844 00000289 50                  <1> 	push ax
   845 0000028A 51                  <1> 	 push cx				; save new size of MCB
   846 0000028B 1E                  <1> 	push ds
   847 0000028C 41                  <1> 	inc cx					; include size of the MCB itself
   848 0000028D 01C8                <1> 	add ax, cx				; ax = where to create new MCB
   849 0000028F 50                  <1> 	 push ax
   850 00000290 8B4503              <1> 	mov ax, word [di+mcbSize]		; current size of MCB
   851 00000293 29C8                <1> 	sub ax, cx				; size of new MCB
   852 00000295 7220                <1> 	jc .internal_error
   853                              <1> 		; CY here means MCB's size currently <= INP:cx.
   854                              <1> 		; ax = 0 is valid, it means an MCB with size 0 is created.
   855                              <1> 		;  (The modified MCB is then shortened by 1 paragraph.)
   856 00000297 8A0D                <1> 	mov cl, byte [di+mcbSignature]
   857 00000299 1F                  <1> 	 pop ds					; ds = new MCB
   858                              <1>  assume ds:MCB
   859 0000029A E845FE              <1> 	call ClearMCBName			; clear name
   860 0000029D 897D05              <1> 	mov word [di+mcbReserved], di
   861 000002A0 897D06              <1> 	mov word [di+mcbReserved + 1], di	; clear reserved bytes
   862 000002A3 880D                <1> 	mov byte [di+mcbSignature], cl		; move letter of MCB to new one
   863 000002A5 894503              <1> 	mov word [di+mcbSize], ax
   864 000002A8 895501              <1> 	mov word [di+mcbOwner], dx		; set size and owner
   865 000002AB 8CDA                <1> 	mov dx, ds
   866 000002AD 1F                  <1> 	pop ds					; restore MCB's address
   867                              <1>  assume ds:MCB
   868 000002AE 8F4503              <1> 	 pop word [di+mcbSize]			; resize the existing MCB
   869 000002B1 C6054D              <1> 	mov byte [di+mcbSignature], 'M'		; link it to new one (if it was 'Z')
   870 000002B4 58                  <1> 	pop ax
   871 000002B5 F8                  <1> 	clc
   872 000002B6 C3                  <1> 	retn
   873                              <1> 
   874                              <1> .internal_error:
   875 000002B7 58                  <1> 	pop ax
   876 000002B8 1F                  <1> 	pop ds
   877                              <1>  assume ds:MCB
   878 000002B9 58                  <1> 	pop ax
   879 000002BA 58                  <1> 	pop ax
   880 000002BB 31D2                <1> 	xor dx, dx
   881 000002BD B80700              <1> 	mov ax, errorMCBDestroyed
   882 000002C0 F9                  <1> 	stc
   883 000002C1 C3                  <1> 	retn
   884                              <1> 
   885                              <1> 
   886                              <1> 		; Modify MCB size
   887                              <1> 		;
   888                              <1> 		; INP:	ax = memory block's segment
   889                              <1> 		;	bx = requested number of paragraphs
   890                              <1> 		; OUT:	bx = new size of block
   891                              <1> 		;	CY if error,
   892                              <1> 		;	 ax = error code
   893                              <1> 		;	NC if successful,
   894                              <1> 		;	 ax = memory block's segment
   895                              <1> 		; CHG:	-
   896                              <1> 		; STK:	21 word
   897                              <1> 		;
   898                              <1> 		; Contraction involves splitting the block into two smaller
   899                              <1> 		; portions. Expansion requires that the block which follows
   900                              <1> 		; is empty. If it is, it is combined with the first block
   901                              <1> 		; to create a huge block, which can then be split.
   902                              <1> 		;
   903                              <1> 		; As MS-DOS does, we'll extend the block to the maximum
   904                              <1> 		; possible size if there's not enough free memory behind it
   905                              <1> 		; to fulfill the request. Also copying MS-DOS's behaviour
   906                              <1> 		; we'll set the owner of the resized MCB if it was resized
   907                              <1> 		; successfully (NC). This allows to allocate specific MCBs,
   908                              <1> 		; although I don't recommend to do so.
   909                              <1> ModifyMCB:
   910                              <1>  assume ds:nothing, es:nothing, ss:DOSGROUP
   911 000002C2 52                  <1> 	push dx
   912 000002C3 E8E8FD              <1> 	call GetMCBOwner			; dx = owner
   913 000002C6 E80200              <1> 	call ModifyMCBRandom
   914 000002C9 5A                  <1> 	pop dx
   915 000002CA C3                  <1> 	retn
   916                              <1> 
   917                              <1> 		; Modify MCB size with random owner
   918                              <1> 		;
   919                              <1> 		; INP:	ax = memory block's segment
   920                              <1> 		;	bx = requested number of paragraphs
   921                              <1> 		;	dx = new owner
   922                              <1> 		; OUT:	bx = new size of block
   923                              <1> 		;	CY if error,
   924                              <1> 		;	 ax = error code
   925                              <1> 		;	NC if successful,
   926                              <1> 		;	 ax = memory block's segment
   927                              <1> 		; CHG:	-
   928                              <1> 		; STK:	19 word
   929                              <1> ModifyMCBRandom:
   930                              <1>  assume ds:nothing, es:nothing, ss:DOSGROUP
   931                              <1> 	lframe near
   932 000002CB 5589E5              <1> 	lenter
   933                              <1> 	lvar	word, alloc
   934 000002CE 53                  <1> 	 push bx
   935                              <1> 	lvar	word, owner
   936 000002CF 52                  <1> 	 push dx
   937                              <1> 
   938 000002D0 52                  <1> 	push dx
   939 000002D1 51                  <1> 	push cx
   940 000002D2 57                  <1> 	push di
   941 000002D3 1E                  <1> 	push ds
   942 000002D4 89C2                <1> 	mov dx, ax
   943 000002D6 E8B1FD              <1> 	call SetLinearMCBFlags			; set order for accessing all MCBs
   944 000002D9 89D0                <1> 	mov ax, dx				; (restore ax without push and pop)
   945 000002DB 31DB                <1> 	xor bx, bx				; largest possible size of MCB, preset to zero
   946 000002DD E8F5FD              <1> 	call GetMCBFromBlock			; get MCB from block address, ax = ds = MCB
   947                              <1> .compare_return_if_CY:
   948 000002E0 721F                <1> 	jc .return				; invalid MCB -->
   949                              <1> .compare:
   950                              <1>  assume ds:MCB
   951 000002E2 8B5D03              <1> 	mov bx, word [di+mcbSize]		; remember current size if request fails
   952 000002E5 8B4EFE              <1> 	mov cx, word [bp + ?alloc]		; cx = requested size
   953 000002E8 39D9                <1> 	cmp cx, bx				; what action is required ?
   954 000002EA 7207                <1> 	jb .contract				; contraction -->
   955 000002EC 740C                <1> 	je .success				; none, succeed -->
   956                              <1> .expand:
   957 000002EE E843FF              <1> 	call CollectNextFreeMCB			; expansion, use next MCB if free
   958                              <1> 	; jc .return				; not free, or MCB chain corrupted -->
   959 000002F1 EBED                <1> 	jmp short .compare_return_if_CY		; compare new size, expand again or contract -->
   960                              <1> .contract:
   961 000002F3 31D2                <1> 	xor dx, dx
   962 000002F5 E891FF              <1> 	call SplitMCB				; free the unused high part of the MCB
   963 000002F8 EBE6                <1> 	jmp short .compare_return_if_CY		; set ?size and return (MCB size now equals _alloc)
   964                              <1> .success:
   965 000002FA 40                  <1> 	inc ax					; point past MCB to actual allocation
   966 000002FB FF76FC              <1> 	push word [bp + ?owner]
   967 000002FE 8F4501              <1> 	pop word [di+mcbOwner]			; re-allocate MCB with requested owner
   968                              <1> 
   969                              <1> 		; Testing on MS-DOS 7.10 revealed that the owner is only
   970                              <1> 		;  set by 21.4A when the resizing was successful. A partial
   971                              <1> 		;  resize (that cannot be fulfilled entirely due to not
   972                              <1> 		;  enough free space) doesn't set the owner.
   973                              <1> .return:
   974                              <1>  assume ds:nothing
   975 00000301 5E                  <1> 	pop si					; discard flags word
   976 00000302 5E                  <1> 	pop si					; discard loop counter word
   977 00000303 5E                  <1> 	pop si
   978 00000304 1F                  <1> 	pop ds
   979                              <1>  assume ds:nothing
   980 00000305 5F                  <1> 	pop di
   981 00000306 59                  <1> 	pop cx
   982 00000307 5A                  <1> 	pop dx
   983 00000308 89EC5D              <1> 	lleave
   984 0000030B C3                  <1> 	lret
   985                              <1> 
   986                              <1> 
   987                              <1> %ifn _UMA		; (Currently only used in non-UMA build.)
   988                              <1> 		; Allocate MCB
   989                              <1> 		;
   990                              <1> 		; INP:	bx = requested number of paragraphs
   991                              <1> 		; OUT:	CY if error,
   992                              <1> 		;	 ax = error code
   993                              <1> 		;	 bx = paragraph size of largest available block (zero if not error 0008h)
   994                              <1> 		;	NC if successful,
   995                              <1> 		;	 ax = segment address of allocation
   996                              <1> 		;	 bx = paragraph size of allocation
   997                              <1> 		; CHG:	-
   998                              <1> 		; STK:	23 word
   999                              <1> AllocateMCB:
  1000                              <1>  assume ds:nothing, es:nothing, ss:DOSGROUP
  1001                              <1> 	push cx
  1002                              <1> %ifn _UMA
  1003                              <1> 	mov ch, byte [ss:alloc_strategy_ext]
  1004                              <1> 	mov cl, byte [ss:AllocMethod]	; cx = flags
  1005                              <1> %else
  1006                              <1> 	call GetMCBFlags			; cx = fixed flags
  1007                              <1> %endif
  1008                              <1> 	db __TEST_IMM8				; (skip push)
  1009                              <1> .flags_cx:
  1010                              <1> 	push cx
  1011                              <1> 	push dx
  1012                              <1> 	call GetMCBOwner			; dx = owner
  1013                              <1> 	call AllocateMCBRandom
  1014                              <1> 	pop dx
  1015                              <1> 	pop cx
  1016                              <1> 	retn
  1017                              <1> %endif
  1018                              <1> 
  1019                              <1> 
  1020                              <1> 		; Allocate MCB with random owner and flags
  1021                              <1> 		;
  1022                              <1> 		; INP:	bx = requested number of paragraphs
  1023                              <1> 		;	cx = allocation strategy
  1024                              <1> 		;	dx = owner
  1025                              <1> 		; OUT:	CY if error,
  1026                              <1> 		;	 ax = error code
  1027                              <1> 		;	 bx = paragraph size of largest available block (zero unless error 0008h)
  1028                              <1> 		;	NC if successful,
  1029                              <1> 		;	 ax = segment address of allocation
  1030                              <1> 		;	 bx = paragraph size of allocation
  1031                              <1> 		; CHG:	-
  1032                              <1> 		; STK:	20 word
  1033                              <1> AllocateMCBRandom:
  1034                              <1>  assume ds:nothing, es:nothing, ss:DOSGROUP
  1035 0000030C 36D006[0000]        <1> 	rol byte [ss:config_collect_all_mcbs], 1
  1036 00000311 7303                <1> 	jnc @F
  1037 00000313 E84BFF              <1> 	call CollectFreeMCBs			; collect free blocks first
  1038                              <1> 		; CHG:	ax
  1039                              <1> 		; We could jump here if CY was returned, indicating
  1040                              <1> 		;  a corrupted MCB chain. However, if it is relevantly
  1041                              <1> 		;  corrupted, this error will also occur later on.
  1042                              <1> @@:
  1043                              <1> 	lframe near
  1044                              <1> 	lvar	word, loopcounter		; (immediately above ?flags)
  1045                              <1> 	lvar	word, flags
  1046                              <1> 	lvar	word, bestfit			; segment of best fit (if cx != FFFFh)
  1047                              <1> 	lvar	word, lastfit			; segment of last fit (if bx >= _alloc)
  1048 00000316 5589E58D66F8        <1> 	lenter
  1049                              <1> 	lvar	word, alloc
  1050 0000031C 53                  <1> 	 push bx
  1051                              <1> 	lvar	word, owner
  1052 0000031D 52                  <1> 	 push dx
  1053                              <1> 
  1054 0000031E 51                  <1> 	push cx
  1055 0000031F 52                  <1> 	push dx
  1056 00000320 56                  <1> 	push si
  1057 00000321 57                  <1> 	push di
  1058 00000322 1E                  <1> 	push ds
  1059 00000323 8D76FC              <1> 	lea si, [bp + ?flags]			; ss:si-> flags
  1060 00000326 E8DDFC              <1> 	call FixMCBFlags			; fix flags to internally used ones
  1061                              <1> %if _UMA
  1062 00000329 36833E[0000]FF      <1> 	cmp word [ss:first_umcb], byte -1	; UMA available ?
  1063 0000032F 7506                <1> 	jne .umavalid
  1064                              <1> %endif
  1065 00000331 80E10F              <1> 	and cl, 0Fh
  1066 00000334 80C910              <1> 	or cl, 10h				; force "LMA only" if no UMA available
  1067                              <1> .umavalid:
  1068 00000337 36890C              <1> 	mov word [ss:si], cx			; store fixed flags
  1069 0000033A 31C0                <1> 	xor ax, ax				; 0000h to get first MCB
  1070 0000033C 36894402            <1> 	mov word [ss:si + 2], ax		; initialise loop counter
  1071 00000340 31DB                <1> 	xor bx, bx
  1072                              <1> 		; variable: size of largest block available
  1073 00000342 B9FFFF              <1> 	mov cx, 0FFFFh
  1074                              <1> 		; variable: best-fit excess size (excess size over requested)
  1075                              <1> .loop:
  1076                              <1>  assume ds:nothing
  1077 00000345 E8D1FD              <1> 	call SNextMCB
  1078 00000348 7303E98C00          <1> 	jc .return				; chain corrupted -->
  1079 0000034D 7536                <1> 	jne .end				; end of chain, look for best or last fit -->
  1080 0000034F 8ED8                <1> 	mov ds, ax
  1081                              <1>  assume ds:MCB
  1082 00000351 397D01              <1> 	cmp word [di+mcbOwner], di		; free block ?
  1083 00000354 75EF                <1> 	jne .loop				; no, next -->
  1084                              <1> 
  1085                              <1> %if 0
  1086                              <1> 
  1087                              <1> ecm 2026: MS-DOS, FreeDOS, EDR-DOS all coalesce free blocks during
  1088                              <1>  the allocation loop, not in a separate loop before as lDOS did.
  1089                              <1>  Support their behaviour as an option (COMPAT=NOCOLLECTALLMCBS).
  1090                              <1>  In case it is selected (separate loop disabled), handle it here.
  1091                              <1> 
  1092                              <1> References:
  1093                              <1> 
  1094                              <1> MS-DOS v4.01: https://anonymous:github@hg.pushbx.org/ecm/msdos4/file/51ad27d225a8/src/DOS/ALLOC.ASM#l207
  1095                              <1> 
  1096                              <1> FreeDOS: https://github.com/FDOS/kernel/blob/417b6d0e2bd62a4de0c8e9f254b69d98ab59fe7a/kernel/memmgr.c#L143
  1097                              <1> 
  1098                              <1> EDR-DOS: https://anonymous:github@hg.pushbx.org/ecm/edrdos/file/6f38a5d95317/drdos/dosmem.nas#l345
  1099                              <1> 
  1100                              <1> Noticed in https://github.com/dmsc/emu2/issues/122
  1101                              <1> 
  1102                              <1> %endif
  1103                              <1> 
  1104                              <1> .again:
  1105 00000356 E8DBFE              <1> 	call CollectNextFreeMCB			; merge next with this one, if free
  1106 00000359 73FB                <1> 	jnc .again				; merged, check if next also free -->
  1107 0000035B 83F808              <1> 	cmp ax, errorInsufficientMemory		; was error "Not enough memory" ?
  1108 0000035E F9                  <1> 	stc
  1109 0000035F 7578                <1> 	jne .return				; no, real error -->
  1110 00000361 8CD8                <1> 	mov ax, ds				; reset ax
  1111                              <1> 
  1112 00000363 8B5503              <1> 	mov dx, word [di+mcbSize]		; get size
  1113                              <1> 
  1114 00000366 39D3                <1> 	cmp bx, dx				; larger than previous largest ?
  1115 00000368 7302                <1> 	jae .notlarger				; no -->
  1116 0000036A 89D3                <1> 	mov bx, dx				; store as new largest
  1117                              <1> .notlarger:
  1118                              <1> 
  1119 0000036C 2B56F6              <1> 	sub dx, word [bp + ?alloc]		; large enough for request ?
  1120 0000036F 72D4                <1> 	jb .loop				; no, next -->
  1121 00000371 36F60403            <1> 	test byte [ss:si], 03h			; strategy zero (first fit) ?
  1122 00000375 742C                <1> 	jz .alloc				; yes, allocate block now -->
  1123                              <1> 
  1124 00000377 8946F8              <1> 	mov word [bp + ?lastfit], ax		; unconditionally store as last fit
  1125                              <1> 
  1126 0000037A 39D1                <1> 	cmp cx, dx				; better than previous best ?
  1127 0000037C 7605                <1> 	jbe .notbetter				; no --> (important: prefer previous if same)
  1128 0000037E 89D1                <1> 	mov cx, dx
  1129 00000380 8946FA              <1> 	mov word [bp + ?bestfit], ax		; store as new best
  1130                              <1> .notbetter:
  1131 00000383 EBC0                <1> 	jmp short .loop
  1132                              <1> 
  1133                              <1> 		; ax = error code 0008h (errorInsufficientMemory) here
  1134                              <1> .end:
  1135                              <1>  assume ds:nothing
  1136 00000385 36F60401            <1> 	test byte [ss:si], 01h
  1137 00000389 7409                <1> 	jz .notbestfit
  1138 0000038B 41                  <1> 	inc cx
  1139 0000038C F9                  <1> 	stc
  1140 0000038D 744A                <1> 	jz .return				; (CY) no fit (cx was still FFFFh) -->
  1141 0000038F 8B46FA              <1> 	mov ax, word [bp + ?bestfit]
  1142 00000392 EB0F                <1> 	jmp short .alloc
  1143                              <1> .notbestfit:
  1144 00000394 36F60403            <1> 	test byte [ss:si], 03h
  1145 00000398 F9                  <1> 	stc
  1146 00000399 743E                <1> 	jz .return				; (CY) first fit requested but none found -->
  1147 0000039B 3B5EF6              <1> 	cmp bx, word [bp + ?alloc]
  1148 0000039E 7239                <1> 	jb .return				; (CY) no block large enough found -->
  1149 000003A0 8B46F8              <1> 	mov ax, word [bp + ?lastfit]
  1150                              <1> .alloc:
  1151 000003A3 8ED8                <1> 	mov ds, ax
  1152                              <1>  assume ds:MCB
  1153 000003A5 8B56F4              <1> 	mov dx, word [bp + ?owner]
  1154 000003A8 895501              <1> 	mov word [di+mcbOwner], dx		; allocate it now
  1155 000003AB E834FD              <1> 	call ClearMCBName			; clear the name
  1156 000003AE 8B4D03              <1> 	mov cx, word [di+mcbSize]		; get size of block
  1157 000003B1 2B4EF6              <1> 	sub cx, word [bp + ?alloc]		; determine remaining block's size
  1158 000003B4 741F                <1> 	je .done				; (NC) no remaining block -->
  1159 000003B6 36F60402            <1> 	test byte [ss:si], 02h			; last fit ?
  1160 000003BA 750C                <1> 	jnz .lastfit				; yes, use upper part -->
  1161 000003BC 8B4EF6              <1> 	mov cx, word [bp + ?alloc]		; size of lower part (allocation)
  1162 000003BF 31D2                <1> 	xor dx, dx				; free upper part
  1163 000003C1 E8C5FE              <1> 	call SplitMCB
  1164 000003C4 7213                <1> 	jc .return				; (else NC)
  1165 000003C6 EB0D                <1> 	jmp short .done
  1166                              <1> .lastfit:
  1167 000003C8 49                  <1> 	dec cx
  1168 000003C9 E8BDFE              <1> 	call SplitMCB				; (dx = owner upper part, cx = size lower part)
  1169 000003CC 720B                <1> 	jc .return				; (else NC)
  1170 000003CE 897D01              <1> 	mov word [di+mcbOwner], di		; free lower part
  1171 000003D1 89D0                <1> 	mov ax, dx
  1172 000003D3 8EDA                <1> 	mov ds, dx				; set ds = ax = allocation
  1173                              <1>  assume ds:MCB
  1174                              <1> .done:					; (NC)
  1175                              <1>  assume ds:nothing
  1176 000003D5 40                  <1> 	inc ax					; point past MCB
  1177 000003D6 8B5D03              <1> 	mov bx, word [di+mcbSize]		; allocated size
  1178                              <1> .return:
  1179 000003D9 7308                <1> 	jnc .noerror				; no error --> (actual allocation size)
  1180 000003DB 83F808              <1> 	cmp ax, errorInsufficientMemory		; "not enough memory" ?
  1181 000003DE 7402                <1> 	je .memerror				; bx set correctly --> (largest seen)
  1182 000003E0 31DB                <1> 	xor bx, bx				; else report none free as largest
  1183                              <1> .memerror:
  1184 000003E2 F9                  <1> 	stc					; set CY again
  1185                              <1> .noerror:
  1186 000003E3 1F                  <1> 	pop ds
  1187                              <1>  assume ds:nothing
  1188 000003E4 5F                  <1> 	pop di
  1189 000003E5 5E                  <1> 	pop si
  1190 000003E6 5A                  <1> 	pop dx
  1191 000003E7 59                  <1> 	pop cx
  1192 000003E8 89EC5D              <1> 	lleave
  1193 000003EB C3                  <1> 	lret
  1194                              <1> 
  1195                              <1> 
  1196                              <1> 		; Allocate largest MCB with random owner and flags
  1197                              <1> 		;
  1198                              <1> 		; INP:	ax = requested maximal number of paragraphs (FFFFh for largest)
  1199                              <1> 		;	bx = requested minimal number of paragraphs
  1200                              <1> 		;	cx = allocation strategy
  1201                              <1> 		;	dx = owner
  1202                              <1> 		; OUT:	CY if error,
  1203                              <1> 		;	 ax = error code
  1204                              <1> 		;	 bx = paragraph size of largest available block (zero unless error 0008h)
  1205                              <1> 		;	NC if successful,
  1206                              <1> 		;	 ax = segment address of allocation
  1207                              <1> 		;	 bx = paragraph size of allocation
  1208                              <1> 		; CHG:	-
  1209                              <1> 		; STK:	29 word
  1210                              <1> 		;
  1211                              <1> 		; If the requested maximal size is smaller than the requested minimal size,
  1212                              <1> 		; the minimal size is forced to the requested maximal size.
  1213                              <1> AllocateLargestMCBRandom:
  1214                              <1>  assume ds:nothing, es:nothing, ss:DOSGROUP
  1215                              <1> .:
  1216                              <1> 	lframe near
  1217 000003EC 5589E5              <1> 	lenter
  1218                              <1> 	lvar	word, min
  1219 000003EF 53                  <1> 	 push bx
  1220                              <1> 
  1221                              <1> %if _UMA
  1222 000003F0 36833E[0000]FF      <1> 	cmp word [ss:first_umcb], byte -1	; UMA available ?
  1223 000003F6 740F                <1> 	je .single				; nope, all area flags turn to "LMA only" anyway -->
  1224 000003F8 F6C180              <1> 	test cl, 80h				; 80h "UMA then LMA" (top priority) ?
  1225 000003FB 7523                <1> 	jnz .dual				; yes, dual area -->
  1226 000003FD F6C140              <1> 	test cl, 40h				; 40h "UMA only" (priority over 20h) ?
  1227 00000400 7505                <1> 	jnz .single				; yes, single area -->
  1228 00000402 F6C120              <1> 	test cl, 20h				; 20h "LMA then UMA" (priority over 10h)
  1229 00000405 7519                <1> 	jnz .dual				; yes, dual area -->
  1230                              <1> .single:
  1231                              <1> %endif
  1232 00000407 89C3                <1> 	mov bx, ax				; maximal size
  1233 00000409 E800FF              <1> 	call AllocateMCBRandom			; request with maximal size
  1234 0000040C 730E                <1> 	jnc .return				; if it succeeded -->
  1235 0000040E 83F808              <1> 	cmp ax, errorInsufficientMemory		; "not enough memory" error ?
  1236 00000411 F9                  <1> 	stc
  1237 00000412 7508                <1> 	jne .return				; if not this error, invalid MCBs -->
  1238 00000414 3B5EFE              <1> 	cmp bx, word [bp + ?min]		; reported largest is large enough for request ?
  1239 00000417 7203                <1> 	jb .return				; no, return the error as is --> (CY)
  1240 00000419 E8F0FE              <1> 	call AllocateMCBRandom			; allocate the reported largest block, pass errors if any
  1241                              <1> .return:
  1242                              <1> %if _UMA
  1243 0000041C 89EC5D              <1> 	lleave code
  1244                              <1> %else
  1245                              <1> 	lleave
  1246                              <1> %endif
  1247 0000041F C3                  <1> 	lret
  1248                              <1> 
  1249                              <1> %if _UMA
  1250                              <1> 		; Area flags involving two areas are split into two calls:
  1251                              <1> 		; If the first area contains a block which is large enough,
  1252                              <1> 		; it is preferred over a possibly larger block in the other
  1253                              <1> 		; area and the other area won't be searched. The reported
  1254                              <1> 		; largest block (if neither area contains one large enough)
  1255                              <1> 		; is the larger one of these reported for both areas.
  1256                              <1> .dual:
  1257                              <1> 	lvar	word, max
  1258 00000420 50                  <1> 	 push ax
  1259                              <1> 	lvar	word, flags
  1260 00000421 51                  <1> 	 push cx
  1261                              <1> 
  1262 00000422 51                  <1> 	push cx
  1263 00000423 E8E0FB              <1> 	call FixMCBFlags			; check whether multiple flags are set
  1264 00000426 80E10F              <1> 	and cl, 0Fh				; clear current flags
  1265 00000429 80C940              <1> 	or cl, 40h				; second try "UMA only"
  1266 0000042C F646FA80            <1> 	test byte [bp + ?flags], 80h		; requested "UMA then LMA" ?
  1267 00000430 7406                <1> 	jz .dual_lmafirst			; no, must be "LMA then UMA" -->
  1268                              <1> %if _ERRORFLAGS
  1269                              <1> 	test byte [bp + ?flags], 40h|20h|10h	; either set ? (multiple)
  1270                              <1> 	jz .dual_validflags_umafirst
  1271                              <1> 	or byte [ss:error_flags], EF_MultipleAllocAreas	; yes, flag
  1272                              <1> .dual_validflags_umafirst:
  1273                              <1> %endif
  1274 00000432 80E10F              <1> 	and cl, 0Fh
  1275 00000435 80C910              <1> 	or cl, 10h				; second try "LMA only"
  1276                              <1> .dual_lmafirst:
  1277 00000438 894EFA              <1> 	mov word [bp + ?flags], cx		; remember area for second try
  1278 0000043B 80F150              <1> 	xor cl, 40h|10h				; set cx to the other one of the single areas
  1279                              <1> 
  1280 0000043E E8ABFF              <1> 	call .					; try to allocate in first area
  1281 00000441 7321                <1> 	jnc .dual_return			; (NC) success -->
  1282 00000443 83F808              <1> 	cmp ax, errorInsufficientMemory		; "not enough memory" error ?
  1283 00000446 751B                <1> 	jne .dual_error				; no, invalid MCB -->
  1284 00000448 8B4EFA              <1> 	mov cx, word [bp + ?flags]		; get other flags
  1285 0000044B 8B46FC              <1> 	mov ax, word [bp + ?max]		; restore maximal value
  1286 0000044E 875EFE              <1> 	xchg bx, word [bp + ?min]		; restore minimal value, save largest available
  1287 00000451 E898FF              <1> 	call .					; try to allocate in second area instead
  1288 00000454 730E                <1> 	jnc .dual_return			; (NC) success -->
  1289 00000456 83F808              <1> 	cmp ax, errorInsufficientMemory		; "not enough memory" error ?
  1290 00000459 7508                <1> 	jne .dual_error				; no, invalid MCB -->
  1291                              <1> 
  1292 0000045B 3B5EFE              <1> 	cmp bx, word [bp + ?min]		; second area contains larger free block ?
  1293 0000045E 7303                <1> 	jae .dual_error				; yes -->
  1294 00000460 8B5EFE              <1> 	mov bx, word [bp + ?min]		; return largest free block of first area instead
  1295                              <1> 
  1296                              <1> .dual_error:
  1297 00000463 F9                  <1> 	stc
  1298                              <1> .dual_return:
  1299 00000464 59                  <1> 	pop cx					; restore cx
  1300 00000465 89EC5D              <1> 	lleave
  1301 00000468 C3                  <1> 	lret
  1302                              <1> %endif
  1303                              <1> 
  1304                              <1> 
  1305                              <1> 		; Allocate MCB, compatible to MS-DOS
  1306                              <1> 		;
  1307                              <1> 		; INP:	bx = requested number of paragraphs
  1308                              <1> 		; OUT:	CY if error,
  1309                              <1> 		;	 ax = error code
  1310                              <1> 		;	 bx = paragraph size of largest available block (zero if not error 0008h)
  1311                              <1> 		;	NC if successful,
  1312                              <1> 		;	 ax = segment address of allocation
  1313                              <1> 		;	 bx = paragraph size of allocation
  1314                              <1> 		; CHG:	-
  1315                              <1> 		;
  1316                              <1> 		; Note:	This function implements the MS-DOS-compatible
  1317                              <1> 		;	 handling where UMA-then-LMA is treated as two areas.
  1318                              <1> %if _UMA
  1319                              <1> AllocateMCBCompatible:
  1320                              <1>  assume ds:nothing, es:nothing, ss:DOSGROUP
  1321 00000469 51                  <1> 	push cx
  1322 0000046A E8FBFB              <1> 	call GetMCBFlags			; cx = fixed flags
  1323 0000046D A8                  <1> 	db __TEST_IMM8				; (skip push)
  1324                              <1> .flags_cx:
  1325 0000046E 51                  <1> 	push cx
  1326 0000046F 52                  <1> 	push dx
  1327 00000470 E83BFC              <1> 	call GetMCBOwner			; dx = owner
  1328 00000473 F6C502              <1> 	test ch, 2				; use lDOS meaning ? (one area)
  1329 00000476 750A                <1> 	jnz .default				; yes -->
  1330 00000478 F6C504              <1> 	test ch, 4				; use two areas ?
  1331 0000047B 750B                <1> 	jnz @F					; yes -->
  1332 0000047D F6C180              <1> 	test cl, 80h				; is it UMA then LMA ?
  1333 00000480 7506                <1> 	jnz @F					; yes, use two areas-->
  1334                              <1> .default:
  1335 00000482 E887FE              <1> 	call AllocateMCBRandom			; else, simply use default
  1336                              <1> .end:
  1337 00000485 5A                  <1> 	pop dx
  1338 00000486 59                  <1> 	pop cx
  1339 00000487 C3                  <1> 	retn
  1340                              <1> 
  1341                              <1> @@:
  1342 00000488 89D8                <1> 	mov ax, bx				; set up maximum size = size
  1343 0000048A E85FFF              <1> 	call AllocateLargestMCBRandom		; call two-area allocation
  1344 0000048D EBF6                <1> 	jmp .end
  1345                              <1> %else
  1346                              <1> AllocateMCBCompatible: equ AllocateMCB
  1347                              <1> AllocateMCBCompatible.flags_cx: equ AllocateMCB.flags_cx
  1348                              <1> %endif
  1349                              <1> 
  1350                              <1> 
  1351                              <1> %if 0
  1352                              <1> 		; INP:	dx = segment of which to get size
  1353                              <1> 		; OUT:	NC if not overlapping,
  1354                              <1> 		;	 bx = size of that segment until next MCB
  1355                              <1> 		;	CY if overlapping (dx points to an MCB,
  1356                              <1> 		;		or not inside any of the MCBs,
  1357                              <1> 		;		or inside a free MCB),
  1358                              <1> 		;	 bx = 0
  1359                              <1> 		;	 ax = error code
  1360                              <1> 		; CHG:	ax
  1361                              <1> GetSizeInMCB:
  1362                              <1>  assume ds:nothing, es:nothing, ss:DOSGROUP
  1363                              <1> 	xor bx, bx
  1364                              <1> 	push cx
  1365                              <1> 	push ds
  1366                              <1> 	push di
  1367                              <1> 	call SetLinearMCBFlags			; set order for accessing all MCBs
  1368                              <1> .loop:
  1369                              <1> 	call SNextMCB				; ax = next MCB
  1370                              <1> 	jc .return				; chain corrupted -->
  1371                              <1> 	jne .error				; no next -->
  1372                              <1> .check:
  1373                              <1> 	mov ds, ax				; ds = MCB
  1374                              <1>  assume ds:MCB
  1375                              <1> 	cmp dx, ax
  1376                              <1> 	jbe .error
  1377                              <1> 	mov cx, ax
  1378                              <1> 	add cx, word [di+mcbSize]
  1379                              <1> 	inc cx					; => next MCB
  1380                              <1> 	cmp dx, cx				; is it equal-to-or-above the next MCB?
  1381                              <1> 	jae .loop				; yes, next -->
  1382                              <1> 	cmp word [di+mcbOwner], di		; is this block free ?
  1383                              <1> 	je .error				; yes -->
  1384                              <1> 	sub cx, dx				; (next MCB) - (block address)
  1385                              <1> 	mov bx, cx				; size
  1386                              <1> 	clc
  1387                              <1> 	jmp .return
  1388                              <1> 
  1389                              <1> .error:
  1390                              <1>  assume ds:nothing
  1391                              <1> 	xor bx, bx
  1392                              <1> 	mov ax, errorMCBInvalid
  1393                              <1> 	stc
  1394                              <1> .return:
  1395                              <1>  assume ds:nothing
  1396                              <1> 	pop si					; discard flags word
  1397                              <1> 	pop si					; discard loop counter word
  1398                              <1> 	pop si
  1399                              <1> 	pop di
  1400                              <1> 	pop ds
  1401                              <1>  assume ds:nothing
  1402                              <1> 	pop cx
  1403                              <1> 	retn
  1404                              <1> %endif
  1405                              <1> 
  1406                              <1> 
  1407                              <1> usesection DOSBIODATA
  1408                              <1> 
  1409                              <1>  global config_collect_all_mcbs
  1410 00000000 FF                  <1> config_collect_all_mcbs:	db -1
  1411                              <1>  global config_collect_free_mcb
  1412 00000001 00                  <1> config_collect_free_mcb:	db 0
    71                                  
    72                                  section DOSCODECODE
    73                                  
    74                                  	global ReleaseOwnersMCBs
    75                                  	global arena_free_process
    76                                  arena_free_process equ ReleaseOwnersMCBs
    77                                  
    78                                  
    79                                  procedure   D_ALLOC,NEAR
    79          ******************       warning: proc D_ALLOC... [-w+user]
    80                                   assume ds:nothing, es:nothing, ss:DOSGROUP
    81 0000048F E8(0000)                	EnterCrit   critMem
    82 00000492 E8D4FF                  	call AllocateMCBCompatible
    83                                  return_CF_bx_crit:
    84 00000495 7315                    	jnc return_CF_crit
    85 00000497 83F808                  	cmp ax, errorInsufficientMemory
    86 0000049A 751B                    	jne return_CY_crit
    87 0000049C E8(0000)                	invoke get_user_stack
    88 0000049F 895C02                  	mov [si + user_BX], bx
    89 000004A2 EB13                    	jmp return_CY_crit
    90                                  EndProc D_ALLOC
    91                                  
    92                                  
    93                                  procedure   D_DEALLOC,NEAR
    93          ******************       warning: proc D_DEALLOC... [-w+user]
    94                                   assume ds:nothing, es:nothing, ss:DOSGROUP
    95 000004A4 E8(0000)                	EnterCrit   critMem
    96 000004A7 8CC0                    	mov ax, es
    97 000004A9 E843FC                  	call ReleaseMCB
    98                                  return_CF_crit:
    99 000004AC E8(0000)                	LeaveCrit   critMem
   100                                  return_CF:
   101 000004AF 7203                    	jc .err
   102 000004B1 E9(0000)                	transfer    SYS_RET_OK
   103                                  .err:
   104 000004B4 E9(0000)                	transfer    SYS_RET_ERR
   105                                  EndProc D_DEALLOC
   106                                  
   107                                  return_CY_crit:
   108 000004B7 F9                      	stc
   109 000004B8 EBF2                    	jmp return_CF_crit
   110                                  
   111                                  
   112                                  procedure   D_SETBLOCK,NEAR
   112          ******************       warning: proc D_SETBLOCK... [-w+user]
   113                                   assume ds:nothing, es:nothing, ss:DOSGROUP
   114 000004BA E8(0000)                	EnterCrit   critMem
   115 000004BD 8CC0                    	mov ax, es
   116 000004BF E800FE                  	call ModifyMCB
   117 000004C2 EBD1                    	jmp return_CF_bx_crit
   118                                  EndProc D_SETBLOCK
   119                                  
   120                                  
   121                                  %else
   122                                  ;
   123                                  ; arena_free_process
   124                                  ; input:    BX - PID of process
   125                                  ; output:   free all blocks allocated to that PID
   126                                  ;
   127                                  	procedure   arena_free_process,NEAR
   128                                  	ASSUME  DS:NOTHING,ES:NOTHING
   129                                  	MOV     DI,arena_signature
   130                                  	MOV     AX,[ss:arena_head]
   131                                  Check_Signature equ check_signature	; NASM port label
   132                                  	CALL    Check_Signature         ; ES <- AX, check for valid block
   133                                  
   134                                  arena_free_process_loop:
   135                                  	retc
   136                                  	PUSH    ES
   137                                  	POP     DS
   138                                  	CMP     [arena_owner],BX     ; is block owned by pid?
   139                                  	JNZ     arena_free_next         ; no, skip to next
   140                                  	MOV     [arena_owner],DI     ; yes... free him
   141                                  
   142                                  arena_free_next:
   143                                  	CMP     BYTE PTR [DI],arena_signature_end
   144                                  					; end of road, Jack?
   145                                  	retz                            ; never come back no more
   146                                  	CALL    arena_next              ; next item in ES/AX carry set if trash
   147                                  	JMP     arena_free_process_loop
   148                                  
   149                                  EndProc arena_free_process
   150                                  
   151                                  ;
   152                                  ; arena_next
   153                                  ; input:    DS - pointer to block head
   154                                  ; output:   AX,ES - pointers to next head
   155                                  ;           carry set if trashed arena
   156                                  ;
   157                                  	procedure   arena_next,NEAR
   158                                  	ASSUME  DS:NOTHING,ES:NOTHING
   159                                  	MOV     AX,DS                   ; AX <- current block
   160                                  	ADD     AX,[arena_size]      ; AX <- AX + current block length
   161                                  	INC     AX                      ; remember that header!
   162                                  ;
   163                                  ;       fall into check_signature and return
   164                                  ;
   165                                  ;       CALL    check_signature         ; ES <- AX, carry set if error
   166                                  ;       RET
   167                                  EndProc arena_next
   168                                  
   169                                  ;
   170                                  ; check_signature
   171                                  ; input:    AX - address of block header
   172                                  ; output:   ES=AX, carry set if signature is bad
   173                                  ;
   174                                  	procedure   check_signature,NEAR
   175                                  	ASSUME  DS:NOTHING,ES:NOTHING
   176                                  	MOV     ES,AX                   ; ES <- AX
   177                                  	CMP     BYTE PTR [ES:DI],arena_signature_normal
   178                                  					; IF next signature = not_end THEN
   179                                  	retz                            ;   GOTO ok
   180                                  	CMP     BYTE PTR [ES:DI],arena_signature_end
   181                                  					; IF next signature = end then
   182                                  	retz                            ;   GOTO ok
   183                                  	STC                             ; set error
   184                                  	return
   185                                  
   186                                  EndProc Check_signature
   187                                  
   188                                  ;
   189                                  ; Coalesce - combine free blocks ahead with current block
   190                                  ; input:    DS - pointer to head of free block
   191                                  ; output:   updated head of block, AX is next block
   192                                  ;           carry set -> trashed arena
   193                                  ;
   194                                  	procedure   Coalesce,NEAR
   195                                  	ASSUME  DS:NOTHING,ES:NOTHING
   196                                  	CMP     BYTE PTR [DI],arena_signature_end
   197                                  					; IF current signature = END THEN
   198                                  	retz                            ;   GOTO ok
   199                                  	CALL    arena_next              ; ES, AX <- next block, Carry set if error
   200                                  	retc                            ; IF no error THEN GOTO check
   201                                  
   202                                  coalesce_check:
   203                                  	CMP     [ES:arena_owner],DI
   204                                  	retnz                           ; IF next block isnt free THEN return
   205                                  	MOV     CX,[ES:arena_size]      ; CX <- next block size
   206                                  	INC     CX                      ; CX <- CX + 1 (for header size)
   207                                  	ADD     [arena_size],CX      ; current size <- current size + CX
   208                                  	MOV     CL,[ES:DI]              ; move up signature
   209                                  	MOV     [DI],CL
   210                                  coalesce equ Coalesce	; NASM port label
   211                                  	JMP     coalesce                ; try again
   212                                  EndProc Coalesce
   213                                  
   214                                  ;SUBTTL $Alloc - allocate space in memory
   215                                  ;PAGE
   216                                  ;
   217                                  ;   Assembler usage:
   218                                  ;           MOV     BX,size
   219                                  ;           MOV     AH,Alloc
   220                                  ;           INT     21h
   221                                  ;         AX:0 is pointer to allocated memory
   222                                  ;         BX is max size if not enough memory
   223                                  ;
   224                                  ;   Description:
   225                                  ;           Alloc returns  a  pointer  to  a  free  block of
   226                                  ;       memory that has the requested  size  in  paragraphs.
   227                                  ;
   228                                  ;   Error return:
   229                                  ;           AX = error_not_enough_memory
   230                                  ;              = error_arena_trashed
   231                                  ;
   232                                  	procedure   D_ALLOC,NEAR
   233                                  	ASSUME  DS:NOTHING,ES:NOTHING
   234                                  
   235                                  	EnterCrit   critMem
   236                                  	XOR     AX,AX
   237                                  	MOV     DI,AX
   238                                  
   239                                  	MOV     [ss:FirstArena],AX         ; init the options
   240                                  	MOV     [ss:BestArena],AX
   241                                  	MOV     [ss:LastArena],AX
   242                                  
   243                                  	PUSH    AX                      ; alloc_max <- 0
   244                                  	MOV     AX,[ss:arena_head]         ; AX <- beginning of arena
   245                                  Check_signature equ check_signature	; NASM port label
   246                                  	CALL    Check_signature         ; ES <- AX, carry set if error
   247                                  	JC      alloc_err               ; IF error THEN GOTO err
   248                                  
   249                                  alloc_scan:
   250                                  	PUSH    ES
   251                                  	POP     DS                      ; DS <- ES
   252                                  	CMP     [arena_owner],DI
   253                                  	JZ      alloc_free              ; IF current block is free THEN examine
   254                                  
   255                                  alloc_next:
   256                                  	CMP     BYTE PTR [DI],arena_signature_end
   257                                  					; IF current block is last THEN
   258                                  	JZ      alloc_end               ;   GOTO end
   259                                  	CALL    arena_next              ; AX, ES <- next block, Carry set if error
   260                                  	JNC     alloc_scan              ; IF no error THEN GOTO scan
   261                                  
   262                                  alloc_err:
   263                                  	POP     AX
   264                                  
   265                                  alloc_trashed:
   266                                  	LeaveCrit   critMem
   267                                  	error   error_arena_trashed
   268                                  
   269                                  alloc_end:
   270                                  	CMP     word [ss:FirstArena],0
   271                                  	JNZ     alloc_do_split
   272                                  
   273                                  alloc_fail:
   274                                  	invoke  get_user_stack
   275                                  	POP     BX
   276                                  	MOV     [SI + user_BX],BX
   277                                  	LeaveCrit   critMem
   278                                  	error   error_not_enough_memory
   279                                  
   280                                  alloc_free:
   281                                  	CALL    coalesce                ; add following free block to current
   282                                  	JC      alloc_err               ; IF error THEN GOTO err
   283                                  	MOV     CX,[arena_size]
   284                                  
   285                                  	POP     DX                      ; check for max found size
   286                                  	CMP     CX,DX
   287                                  	JNA     alloc_test
   288                                  	MOV     DX,CX
   289                                  
   290                                  alloc_test:
   291                                  	PUSH    DX
   292                                  	CMP     BX,CX                   ; IF BX > size of current block THEN
   293                                  	JA      alloc_next              ;   GOTO next
   294                                  
   295                                  	CMP     word [ss:FirstArena],0
   296                                  	JNZ     alloc_best
   297                                  	MOV     [ss:FirstArena],DS         ; save first one found
   298                                  alloc_best:
   299                                  	CMP     word [ss:BestArena],0
   300                                  	JZ      alloc_make_best         ; initial best
   301                                  	PUSH    ES
   302                                  	MOV     ES,[ss:BestArena]
   303                                  	CMP     [ES:arena_size],CX      ; is size of best larger than found?
   304                                  	POP     ES
   305                                  	JBE     alloc_last
   306                                  alloc_make_best:
   307                                  	MOV     [ss:BestArena],DS          ; assign best
   308                                  alloc_last:
   309                                  	MOV     [ss:LastArena],DS          ; assign last
   310                                  	JMP     alloc_next
   311                                  
   312                                  ;
   313                                  ; split the block high
   314                                  ;
   315                                  alloc_do_split_high:
   316                                  	MOV     DS,[ss:LastArena]
   317                                  	MOV     CX,[arena_size]
   318                                  	SUB     CX,BX
   319                                  	MOV     DX,DS
   320                                  	JE      alloc_set_owner         ; sizes are equal, no split
   321                                  	ADD     DX,CX                   ; point to next block
   322                                  	MOV     ES,DX                   ; no decrement!
   323                                  	DEC     CX
   324                                  	XCHG    BX,CX                   ; bx has size of lower block
   325                                  	JMP     alloc_set_sizes         ; cx has upper (requested) size
   326                                  	nop	; identicalise
   327                                  
   328                                  ;
   329                                  ; we have scanned memory and have found all appropriate blocks
   330                                  ; check for the type of allocation desired; first and best are identical
   331                                  ; last must be split high
   332                                  ;
   333                                  alloc_do_split:
   334                                  	CMP     BYTE PTR [ss:AllocMethod], 1
   335                                  	JA      alloc_do_split_high
   336                                  	MOV     DS,[ss:FirstArena]
   337                                  	JB      alloc_get_size
   338                                  	MOV     DS,[ss:BestArena]
   339                                  alloc_get_size:
   340                                  	MOV     CX,[arena_size]
   341                                  	SUB     CX,BX                   ; get room left over
   342                                  	MOV     AX,DS
   343                                  	MOV     DX,AX                   ; save for owner setting
   344                                  	JE      alloc_set_owner         ; IF BX = size THEN (don't split)
   345                                  	ADD     AX,BX
   346                                  	INC     AX                      ; remember the header
   347                                  	MOV     ES,AX                   ; ES <- DS + BX (new header location)
   348                                  	DEC     CX                      ; CX <- size of split block
   349                                  alloc_set_sizes:
   350                                  	MOV     [arena_size],BX      ; current size <- BX
   351                                  	MOV     [ES:arena_size],CX      ; split size <- CX
   352                                  	MOV     BL,arena_signature_normal
   353                                  	XCHG    BL,[DI]              ; current signature <- 4D
   354                                  	MOV     [ES:DI],BL              ; new block sig <- old block sig
   355                                  	MOV     [ES:arena_owner],DI
   356                                  
   357                                  alloc_set_owner:
   358                                  	MOV     DS,DX
   359                                  	MOV     AX,[ss:CurrentPDB]
   360                                  	MOV     [arena_owner],AX
   361                                  	MOV     AX,DS
   362                                  	INC     AX
   363                                  	POP     BX
   364                                  	LeaveCrit   critMem
   365                                  	transfer    SYS_RET_OK
   366                                  
   367                                  EndProc D_alloc
   368                                  
   369                                  ;SUBTTL $SETBLOCK - change size of an allocated block (if possible)
   370                                  ;PAGE
   371                                  ;
   372                                  ;   Assembler usage:
   373                                  ;           MOV     ES,block
   374                                  ;           MOV     BX,newsize
   375                                  ;           MOV     AH,setblock
   376                                  ;           INT     21h
   377                                  ;         if setblock fails for growing, BX will have the maximum
   378                                  ;         size possible
   379                                  ;   Error return:
   380                                  ;           AX = error_invalid_block
   381                                  ;              = error_arena_trashed
   382                                  ;              = error_not_enough_memory
   383                                  ;              = error_invalid_function
   384                                  ;
   385                                  	procedure   D_SETBLOCK,NEAR
   386                                  	ASSUME  DS:NOTHING,ES:NOTHING
   387                                  	EnterCrit   critMem
   388                                  	MOV     DI,arena_signature
   389                                  	MOV     AX,ES
   390                                  	DEC     AX
   391                                  	CALL    check_signature
   392                                  	JNC     setblock_grab
   393                                  
   394                                  setblock_bad:
   395                                  	JMP     alloc_trashed
   396                                  
   397                                  setblock_grab:
   398                                  	MOV     DS,AX
   399                                  	CALL    coalesce
   400                                  	JC      setblock_bad
   401                                  	MOV     CX,[arena_size]
   402                                  	PUSH    CX
   403                                  	CMP     BX,CX
   404                                  	JBE     alloc_get_size
   405                                  	JMP     alloc_fail
   406                                  EndProc D_setblock
   407                                  
   408                                  ;SUBTTL $DEALLOC - free previously allocated piece of memory
   409                                  ;PAGE
   410                                  ;
   411                                  ;   Assembler usage:
   412                                  ;           MOV     ES,block
   413                                  ;           MOV     AH,dealloc
   414                                  ;           INT     21h
   415                                  ;
   416                                  ;   Error return:
   417                                  ;           AX = error_invalid_block
   418                                  ;              = error_arena_trashed
   419                                  ;
   420                                  	procedure   D_DEALLOC,NEAR
   421                                  	ASSUME  DS:NOTHING,ES:NOTHING
   422                                  	EnterCrit   critMem
   423                                  	MOV     DI,arena_signature
   424                                  	MOV     AX,ES
   425                                  	DEC     AX
   426                                  	CALL    check_signature
   427                                  	JC      dealloc_err
   428                                  	MOV     [ES:arena_owner],DI
   429                                  	LeaveCrit   critMem
   430                                  	transfer    SYS_RET_OK
   431                                  
   432                                  dealloc_err:
   433                                  	LeaveCrit   critMem
   434                                  	error   error_invalid_block
   435                                  EndProc D_DEALLOC
   436                                  %endif
   437                                  
   438                                  ;SUBTTL $AllocOper - get/set allocation mechanism
   439                                  ;PAGE
   440                                  ;
   441                                  ;   Assembler usage:
   442                                  ;           MOV     AH,AllocOper
   443                                  ;           MOV     BX,method
   444                                  ;           MOV     AL,func
   445                                  ;           INT     21h
   446                                  ;
   447                                  ;   Error return:
   448                                  ;           AX = error_invalid_function
   449                                  ;
   450                                  	procedure   D_AllocOper,NEAR
   450          ******************       warning: proc D_AllocOper... [-w+user]
   451                                   assume ds:nothing, es:nothing, ss:DOSGROUP
   452                                  %ifdef LDOSMEM
   453 000004C4 3C03                    	cmp al, 3
   454 000004C6 7767                    	ja alloc_oper_invalid
   455 000004C8 740E                    	je set_umb_link
   456                                  %endif
   457 000004CA 3C01                    	CMP     AL,1
   458 000004CC 726B                    	JB      AllocOperGet
   459 000004CE 7476                    	JZ      AllocOperSet
   460                                  %ifdef LDOSMEM
   461                                  get_umb_link:
   462 000004D0 31C0                    	xor ax, ax
   463 000004D2 36A0[0000]              	mov al, byte [ss:enable_uma]	; get allow/disallow flag
   464 000004D6 EBD9                    	transfer SYS_RET_OK
   465                                  
   466                                  set_umb_link:
   467 000004D8 368B16[0000]            	mov dx, word [ss:first_umcb]	; any UMA ?
   468 000004DD 83FAFF                  	cmp dx, -1
   469 000004E0 7507                    	jne .got
   470                                  
   471                                  .none:
   472 000004E2 F6C301                  	test bl, 1			; (NC)
   473 000004E5 7548                    	jnz alloc_oper_invalid
   474 000004E7 EB41                    	jmp alloc_oper_CF
   475                                  
   476                                  .got:
   477 000004E9 E8(0000)                	EnterCrit   critMem
   478 000004EC 50                      	push ax
   479 000004ED E89AFB                  	call SetLinearMCBFlags		; ax = 0 = get first MCB
   480                                  .next:
   481 000004F0 89C2                    	mov dx, ax			; remember MCB in case it is the target
   482 000004F2 E824FC                  	call SNextMCB			; get next MCB
   483 000004F5 722D                    	jc .end
   484 000004F7 7527                    	jnz .error			; end ? UMCB not found -->
   485 000004F9 363B06[0000]            	cmp ax, word [ss:first_umcb]	; this the first UMCB ?
   486 000004FE 75F0                    	jne .next			; no, loop -->
   487                                  
   488 00000500 85D2                    	test dx, dx			; no previous ?
   489 00000502 741C                    	jz .error			; if so, error -->
   490 00000504 8EC2                    	mov es, dx			; => MCB that points to first UMCB
   491                                   assume es:MCB
   492 00000506 F6C301                  	test bl, 1			; (NC)
   493 00000509 7408                    	jz .set_Z			; 0, set to 'Z' -->
   494                                  .set_M:
   495 0000050B 26C60600004D            	mov byte [es:mcbSignature], "M"	; nonzero, set to 'M'
   496 00000511 EB06                    	jmp @F
   497                                  .set_Z:
   498 00000513 26C60600005A            	mov byte [es:mcbSignature], "Z"
   499                                  @@:
   500                                  %if _ERRORFLAGS
   501                                  	test bh, bh
   502                                  	jz @F
   503                                  	or byte [ss:error_flags], EF_InvalidUMBLink	; invalid UMB link bits set
   504                                  @@:
   505                                  %endif
   506 00000519 36881E[0000]            	mov byte [ss:enable_uma], bl	; store UMB link
   507 0000051E EB04                    	jmp .end
   508                                  
   509                                  .error:
   510                                   assume es:nothing
   511 00000520 B80700                  	mov ax, errorMCBDestroyed
   512 00000523 F9                      	stc
   513                                  .end:
   514 00000524 5E                      	pop si					; discard flags word
   515 00000525 5E                      	pop si					; discard loop counter word
   516 00000526 5E                      	pop si
   517 00000527 E8(0000)                	LeaveCrit   critMem
   518                                  alloc_oper_CF:
   519 0000052A 7317                    	jnc alloc_oper_ok_ax
   520 0000052C 5E                      	pop si
   521 0000052D EB85                    	transfer SYS_RET_ERR
   522                                  %endif
   523                                  
   524                                  alloc_oper_invalid:
   525                                  errLoc_mem equ errLOC_Mem	; NASM port equate
   526 0000052F 36C606[0000]05          	MOV     byte [ss:EXTERR_LOCUS],errLoc_mem ; Extended Error Locus
   527 00000535 B001EBF4                	error   error_invalid_function
   528                                  AllocOperGet:
   529 00000539 36A0[0000]              	MOV     AL,BYTE PTR [ss:AllocMethod]
   530                                  %ifdef LDOSMEM
   531 0000053D 368A26[0000]            	mov ah, [ss:alloc_strategy_ext]
   532                                  
   533                                  alloc_oper_ok:
   534 00000542 A8                      	db __TEST_IMM8		; (skip pop)
   535                                  alloc_oper_ok_ax:
   536 00000543 58                      	pop ax
   537                                  %else
   538                                  	mov ah, 0
   539                                  %endif
   540 00000544 EB90                    	transfer    SYS_RET_OK
   541                                  AllocOperSet:
   542 00000546 36881E[0000]            	MOV     [ss:AllocMethod],BL
   543 0000054B 36883E[0000]            	mov [ss:alloc_strategy_ext], bh
   544 00000550 EBF2                    	transfer    SYS_RET_OK
   545                                  EndProc D_AllocOper
   546                                  
   547                                      END
