; Usage of the works is permitted provided that this
; instrument is retained with the works, so that any entity
; that uses the works is notified of this instrument.
;
; DISCLAIMER: THE WORKS ARE WITHOUT WARRANTY.

; Input: V4 = segment to allocate, V5 = how many paragraphs to allocate

if (v4 < 50 || v4 > F000 || (v4 + v5) >= 1_0000 ) then goto :errorearly
g = PSP:0	; terminate process if any
r sp 400	; set stack at top of 1 KiB
a 100
 mov bx, 40
 mov ah, 4A
 int 21		; resize to 1 KiB
 mov ax, 5802
 int 21
 xor ah, ah	; get UMB link status
 push ax	; preserve it
 mov ax, 5803
 mov bx, 1
 int 21		; enable UMB link
 mov bx, -1
 mov ah, 48
 int 21		; make DOS coalesce free blocks
 mov ah, 52
 int 21		; get DOS list of lists in es:bx
 .
r v0 aao
a
 nop
 pop bx
 mov ax, 5803
 int 21		; restore UMB link status
 nop
 .
r v1 aao-1
g v0
; now es:bx -> list of lists
r vc word [es:bx - 2]			; get first MCB
if (vc < 50 || vc > a000) then goto :error

@:loop
@if (byte [vc:0] != 4D && byte [vc:0] != 5A) then goto :error
@r vd = word [vc:3]
@r ve = vc + vd + 1
@if ( ve < v4 ) then goto :next
@if ( vc > (v4 + v5) ) then goto :next
if (word [vc:1]) then goto :notfree
if ( ve < (v4 + v5) ) then goto :overlap
; Found block

if ( ve == (v4 + v5) ) then goto :noendblock

r byte [v4+v5:0] := byte [vc:0]		; use letter of VC block
r word [v4+v5:1] := 0			; owner zero means free
r word [v4+v5:3] := ve - (v4+v5) - 1	; size so it links to VE block
r byte [vc:0] := 4D			; set letter of VC block to 'M'
r word [vc:3] := (v4+v5) - vc - 1	; shrink VC block

:noendblock
if ( vc == (v4 - 1) ) then goto :nostartblock
r byte [v4 - 1:0] := byte [vc:0]	; use letter of VC block
r byte [vc:0] := 4D			; set letter of VC block to 'M'
r word [vc:3] := v4 - 1 - vc - 1	; shrink VC block

:nostartblock
r word [v4 - 1:1] := 8			; S/SC/SD MCB
r word [v4 - 1:3] := v5			; set size
e v4 - 1:8 "S",0,0,0,0,0,0,0		; lDOS SMCB with S_OTHER
; Done
goto :end

@:next
@if (byte [vc:0] == 5A) then goto :notfound
@r vc := ve
@goto :loop

:errorearly
; Error occurred!
goto :eof

:error
; Error occurred!
goto :end

:overlap
; Block overlaps area to reserve!
goto :end

:notfound
; Block not found!
goto :end

:notfree
; Block is not free!
goto :end

:end
g v1		; restore UMB link