; 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