
%if 0

lDOS COMLOADER - load embedded programs
 by E. C. Masloch, 2018--2025

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.

Parts copied from msdos4/src/CMD/DEBUG/DEBCOM2.ASM and
msdos4/src/CMD/DEBCOM3.ASM (under MIT license).

%endif

	cpu 8086

%include "lmacros3.mac"
%include "lstruct.mac"
%include "mzheader.mac"


	numdef MCP, 0
	numdef MZEXESUPPORT, 1

%define FOLLOWS ENTRY
%define ENDS none
%define ADDRESS 0
%define COMMAND_LIST none, "", ""
%assign SHELL_DELTA 0
	%imacro nextcomprogram 2-4+.nolist "",vstart=256
	align 16, db 26h
%[ENDS]_end:
addsection %1, follows=%[FOLLOWS] %4
%1_start:
%1_position equ ADDRESS
 %define FOLLOWS %1
 %define ENDS %1
 %xdefine ADDRESS (ADDRESS + (%1_end - %1_start))
 %xdefine COMMAND_LIST COMMAND_LIST, %1, %2, %3
 %xdefine SHELL_DELTA (SHELL_DELTA + (%1_end - %1_start))
	%endmacro

	struc COMPROGRAMLIST_ENTRY
cplPositionSeg:	resw 1
cplLength:
%if _MZEXESUPPORT
cplLengthParas:	resw 1
%else
cplLengthWords:	resw 1
%endif
cplNameString:	resw 1
cplHelpString:	resw 1
	endstruc

	%imacro comprogramlist 0-*
%if (%0 % 3) != 0 || %0 < 6
 %error Expected number of parameters a multiple of 3 and at least 6
%endif
%rep (%0 - 6) / 3
%rotate 3
%1_list_entry:
	istruc COMPROGRAMLIST_ENTRY
at cplPositionSeg,	dw %1_position >> 4
%if _MZEXESUPPORT
at cplLengthParas,	dw (%1_end - %1_start) >> 4
%else
at cplLengthWords,	dw (%1_end - %1_start) >> 1
%endif
at cplNameString,	dw msg_name.%1 - ..@base
at cplHelpString,	dw msg_help.%1 - ..@base
	iend
%endrep
	%endmacro

	%imacro comprogrammessages 0-*
%if (%0 % 3) != 0 || %0 < 6
 %error Expected number of parameters a multiple of 3 and at least 6
%endif
%rep (%0 - 6) / 3
%rotate 3
msg_name.%1:	asciz %2
msg_help.%1:	asciz %3
%endrep
	%endmacro

addsection ENTRY, vstart=256 start=0 align=16
startentry:
	mov cx, cs
	add cx, paras(COMLOADER_position) + paras(startentry_size) + 16
	push cx
	xor cx, cx
	push cx
%if _MCP
	mov cx, [cs:clu_flag]
%endif
	retf

	align 16, db 38
%if _MCP
	_fill 48, 38, startentry
	db "lDOS MCP"
clu_flag:
	dw 0			; 1 = loaded from CLU in the LMA,
				;  3 = loaded from CLU in the UMA

	align 16, db 0
%endif
	endarea startentry

nextcomprogram COMINT3, "INT3", "program that breaks to a debugger"
	mov dx, .msg
	mov ah, 09h
	int 21h
	int3
	mov ax, 4C00h
	int 21h

.msg:	db "Embedded executable test loaded.",13,10,36


nextcomprogram COMEMPTY, "EMPTY", "empty program for testing"
	mov ax, 4C00h
	int 21h


nextcomprogram COMLIST, "LIST", "lists all available programs"
	mov dx, .msg
	mov ah, 09h
	int 21h

	mov ds, cx		; ds:bx -> command program name table
	mov es, cx

	mov di, bx		; es:di = ds:di -> table
.loop:
%if _MCP
	cmp word [di + cplLength], -1
%else
	cmp word [di + cplLength], 0
%endif
	je .end
	mov dx, word [di + cplNameString]
	add dx, bx
	 push di
	mov di, dx
	mov al, 0
	mov cx, -1
	repne scasb
	neg cx
	dec cx
	dec cx
	mov ah, 40h
	push bx
	mov bx, 1
	int 21h
	pop bx

	cmp cx, 8
	mov cx, 1
	jae @F
	inc cx
@@:
	mov ah, 02h
	mov dl, 9
	int 21h
	loop @B

	 pop di
	 mov dx, word [di + cplHelpString]
	 add dx, bx
	 push di

	mov di, dx
	mov al, 0
	mov cx, -1
	repne scasb
	neg cx
	dec cx
	dec cx
	mov ah, 40h
	push bx
	mov bx, 1
	int 21h
	pop bx

	mov ah, 02h
	mov dl, 13
	int 21h
	mov ah, 02h
	mov dl, 10
	int 21h

	 pop di
	add di, COMPROGRAMLIST_ENTRY_size
	jmp .loop

.end:
	mov ax, 4C00h
	int 21h

.msg:
	db "Command program names:",13,10,36


	numdef COMPRESSEDCOMLOADER, 1

nextcomprogram COMINSTSECT, "INSTSECT", "installs boot sectors to drives"
%if _COMPRESSEDCOMLOADER
	incbin "bin/instsect.exe"
%else
	incbin "bin/instsect.com"
%endif


nextcomprogram COMPATLDOS, "PATLDOS", "patches ldos.com kernel file (lCFG block)"
%if _COMPRESSEDCOMLOADER
	incbin "bin/patldos.exe"
%else
	incbin "bin/patldos.com"
%endif


nextcomprogram COMVERSION, "VERSION", "lists the version of this kernel file"
	incbin "tmp/version.com"


%if _MCP
nextcomprogram COMCOMMAND, "COMMAND", "FreeCOM command line shell"
	incbin "tmp/command.com"
shell_end:
	align 16, db 38
shell_padding_length equ $ - shell_end
%assign SHELL_DELTA 0

nextcomprogram COMDEBUG, "DEBUG", "lDebug 86-DOS debugger"
%endif


nextcomprogram COMLOADER, "", "", vstart=0
		; INP:	ds = es = PSP
		;	cs:ip = COMLOADER segment : 0
		;	ss:sp -> stack behind COMLOADER
		;	if _MCP:
		;	 cx = clu_flag (0 = normal, 1 = load FreeCOM,
		;	 3 = load FreeCOM to UMA)
	int3
%if _MZEXESUPPORT
	jmp @F
relocatecomloader: equ $
	rep movsw		; move downwards
	push es
	call .retf		; relocate
	jmp donerelocatedcomloader
				; continue at relocated comloader
.retf:
	retf

%if ($ - relocatecomloader) > 16
 %error Relocate comloader is too large
%endif


@@:
%endif
%if _MCP
	cmp cx, 1
	jb @F
	je .freecom_for_clu
	not byte [cs:relocate_to_uma]
	cmp cx, 3
	je .freecom_for_clu
	push cs
	pop ds
	mov dx, msg.invalidcluflag
	mov ah, 09h
	int 21h			; display

	mov ax, 4CFFh
	int 21h

.freecom_for_clu:
	mov si, COMCOMMAND_list_entry
	mov bx, word [cs:si + cplPositionSeg]
				; address (paragraphs from after INIT3 end MCB)
	push word [cs:si + cplLength]
				; number of words/paras
	mov si, 81h
	jmp .common

@@:
%endif
	push es
	pop ds
	mov si, 81h		; PSP command line
@@:
	lodsb
	cmp al, 9
	je @B
	cmp al, 32
	je @B			; skip leading spaces -->
	jb .no_name_given	; end of line ? -->

	mov di, si
	dec di			; -> name

	db __TEST_IMM8
@@:
	lodsb
	cmp al, 'a'
	jb @F
	cmp al, 'z'
	ja @F
	sub al, 'a' - 'A'
	mov byte [si - 1], al
@@:
	cmp al, 32
	ja @BB
	mov byte [si - 1], 0	; ! al preserved here until after .got_it

	mov cx, si
	sub cx, di

	push cs
	pop ds
	mov si, programstable

.loop:
%if _MCP
	cmp word [si + cplLength], -1
%else
	cmp word [si + cplLength], 0		; empty payload ?
%endif
	je ..@error_unknown_name_given		; yes, end of table -->

	push cx
	push si
	push di
	mov si, word [si + cplNameString]
	add si, programstable
	repe cmpsb		; this command ?
	pop di
	pop si
	pop cx
	je .got_it

	add si, COMPROGRAMLIST_ENTRY_size
	jmp .loop

.no_name_given:
	push cs
	pop ds
%if _MCP
	mov si, COMDEBUG_list_entry

	push cs
	pop ds
	mov dx, msg.intro	; -> .msg
	mov ah, 09h
	int 21h			; display

	mov dx, msg.loading_before
	mov ah, 09h
	int 21h

	mov dx, word [si + cplNameString]
	add dx, programstable
	xor cx, cx
	mov bx, dx
	mov ax, 4000h
	dw __TEST_IMM16		; skip two inc
@@:
	inc bx
	inc cx
	cmp al, [bx]
	jne @B
	mov bx, 1
	int 21h

	mov dx, msg.loading_after
	mov ah, 09h
	int 21h
%else
	mov si, COMVERSION_list_entry
	mov bx, word [si + cplPositionSeg]
				; address (paragraphs from after INIT3 end MCB)
%endif
	push word [si + cplLength]
				; number of words/paras

	push es
	pop ds			; => PSP

	mov si, 81h
	jmp .common

.got_it:
	mov bx, word [si + cplPositionSeg]
				; address (paragraphs from after INIT3 end MCB)
	push word [si + cplLength]
				; number of words/paras

	dec cx
	 push ax
	 push bx
	cmp si, COMVERSION_list_entry
	je @F
	push cs
	pop ds
	mov dx, msg.intro	; -> .msg
	mov ah, 09h
	int 21h			; display

	mov dx, msg.loading_before
	mov ah, 09h
	int 21h

	mov dx, word [si + cplNameString]
	add dx, programstable
	mov ah, 40h
	mov bx, 1
	int 21h

	mov dx, msg.loading_after
	mov ah, 09h
	int 21h

	push es
	pop ds			; => PSP

@@:
	add di, cx
	mov si, di
	 pop bx
	 pop ax
	mov byte [si], al	; ! preserved from before .loop

.common:
	mov di, 81h
	mov cx, 7Fh
	rep movsb		; move down the command line trail

	mov di, 81h
	mov cx, 7Fh
	mov al, 13
	repne scasb
; COUNTER ->13, cx=7Fh, di=81h
; scasb
; COUNTER 13 ->, ZR, cx=7Eh, di=82h
	neg cx
; cx=-7Eh
	add cx, 7Eh
; cx=0

; COUNTER ->32, 13, cx=7Fh, di=81h
; scasb
; COUNTER 32 ->13, NZ, cx=7Eh, di=82h
; scasb
; COUNTER 32 13 ->, ZR, cx=7Dh, di=83h
	; neg cx
; cx=-7Dh
	; add cx, 7Eh
; cx=1
	mov byte [80h], cl	; update command line trail length

%ifn _MZEXESUPPORT
	mov di, 256
%endif
	pop cx			; number of words/paras (cplLength)
	mov ax, cs
	sub ax, (COMLOADER_position >> 4)
	add ax, bx		; address => source

	push ax
	mov si, 81h		; -> edited command line tail
	call parse_dssi_cmdline_to_es_fcbs
				; es = ds => PSP, fill FCBs
	pop ax
	push bx			; push bx = drive validity flags

%if _MCP
	rol byte [cs:relocate_to_uma], 1
	jnc load_not_relocate
load_maybe_relocate:
	push ax
	push cx
	push es
 %if _MZEXESUPPORT
	mov ds, ax
	xor bx, bx
	cmp word [bx + exeSignature], "MZ"
	je .exe
	cmp word [bx + exeSignature], "ZM"
	je .exe
.com:
	mov ax, cx
	add ax, paras(100h + 100h)
	mov bx, -1
	jmp .common

.exe:
	not byte [cs:relocating_is_exe]
	mov bp, word [bx + exePages]
	mov cl, 5
	shl bp, cl		; = how many paragraphs in header + image
	mov ax, word [bx + exeHeaderSize]
	sub bp, ax		; = how many paragraphs in image
	jbe error_format
		; lMS-DOS doesn't ever use exeExtraBytes.
		;  we can ignore it likewise.
	mov cx, bp
	mov ax, word [bx + exeMinAlloc]
	mov bx, word [bx + exeMaxAlloc]
	cmp ax, bx		; minimum > maximum ?
	ja error_format
	test bx, bx		; maximum == 0 ?
	jz error_format		; not supported -->
	add bx, cx		; bx = maximum allocation size (maxalloc + image)
	jc .unlimited
	add bx, 10h		; account for PSP
	jnc @F
.unlimited:
	mov bx, -1		; if maximum requested, pass along bx = 0FFFFh
@@:
	add ax, cx
	jc error_format
	add ax, 10h		; ax = minimum requested
	jc error_format

.common:
 %else
	mov ax, cx
	add ax, 7		; round up
	shr ax, 1
	shr ax, 1
	shr ax, 1		; words times 8 = paragraphs
	add ax, paras(100h + 100h)
	mov bx, -1
 %endif
	mov si, bx		; si = maximum
	xchg di, ax		; di = minimum

	mov ax, 5802h
	int 21h
	xor ah, ah
	push ax

	mov ax, 5800h
	int 21h
	push ax

	mov ax, 5803h
	mov bx, 1		; enable UMA link
	int 21h

	mov ax, 5801h
	mov bx, 0040h		; first fit, UMA-only
	int 21h

	mov ah, 51h
	int 21h
	mov ds, bx
	mov cx, word [pspEnvironment]
	test cx, cx
	jz .noenv

	dec cx
	mov ds, cx
	xor cx, cx
	mov bx, word [mcbSize]
	mov ah, 48h
	int 21h
	jc .unable_j_CY
	xchg cx, ax
.noenv:

	mov bx, si
	mov ah, 48h
	int 21h
	jnc .got

	cmp bx, di
	jb .unable_j_CY

	mov ah, 48h
	int 21h
.unable_j_CY:
	jc .unable

.got:
	mov word [cs:..@relocated_psp_size], bx
	mov dx, ax		; dx = psp block, cx = env block

	pop bx
	mov ax, 5801h
	int 21h

	pop bx
	mov ax, 5803h
	int 21h

.copyenv:
	push dx
	mov ah, 51h
	int 21h
	mov ds, bx		; => PSP
	mov word [cs:..@original_psp], bx
	jcxz .doneenv
	dec cx
	mov es, cx		; => new env MCB
	mov word [es:mcbOwner], dx
				; = new owner
	inc cx			; => new env
	mov dx, cx
	xchg cx, [pspEnvironment]
				; update, and get => old env
	mov ax, cx
	mov cx, word [es:mcbSize]
	call movp
	pop dx
.doneenv:

	mov ah, 51h
	int 21h
	mov ax, dx		; ax = new process
	mov dx, bx		; dx = old process
	mov es, ax		; newly allocated block
	mov ds, dx		; (no cs prefix to avoid an 8086 bug)
	xor di, di
	xor si, si
	mov cx, 80h

			; This used to have a cs prefix, but it was removed
			;  to ensure proper operation on 8086 implementations
			;  with a bug when rep and another prefix occurred.
			; Instead ds is set to dx = cs, costing one byte.
	rep movsw		; copy process into newly allocated block

	; call setmcb		; make the block own itself
	dec ax
	mov es, ax		; es => MCB of allocated block
	inc ax			; ax => allocated block!
	mov di, mcbName		; es:di -> MCB name field
	mov si, dx
	dec si			; => original PSP MCB
	mov ds, si
	mov si, di		; -> original MCB name
	movsw
	movsw
	movsw
	movsw			; Force MCB string
	mov word [ es:mcbOwner ], ax	; Set owner to itself
	mov word [ mcbOwner ], ax	; Set original block owner to new
	mov ds, dx		; ds = old PSP

	mov es, ax		; es = new PSP
	mov di, pspPHT
	mov cx, pspPHT_size
	mov word [es:pspPHTAddress + 2], ax
	mov word [es:pspPHTAddress], di	; fix the new PSP's PHT pointer
	mov word [es:pspPHTEntries], cx	;  and the count of PHT entries field
	 push ax
	mov al, -1
	 push di
	mov bx, cx		; = 20
	rep stosb		; initialise new PHT with empty entries
	 pop di
	mov cx, word [pspPHTEntries]	; cx = count of PHT entries
	cmp cx, bx		; >= 20 ?
	jb .shortertable	; no -->
	mov cx, bx		; limit to 20
.shortertable:
	lds si, [pspPHTAddress]	; ds:si-> old PHT
	push si
	push cx
	rep movsb		; get all entries
	pop cx
	pop di
	 push ds
	 pop es			; es:di-> old PHT
	rep stosb		; fill moved entries with -1 (closed)
	 pop ax
	mov ds, dx		; ds = old PSP
	mov word [pspInt22], .terminated
	mov word [pspInt22 + 2], cs	; set interrupt vectors to ours
	mov word [pspParent], ax	; set parent PSP to the relocated one
	mov es, ax		; => new PSP
	mov word [es:pspStack + 2], ss
				; set SS used by process termination

	xchg ax, bx		; bx = new location, dx = old location
	mov ax, 335Dh
	int 21h			; PSP relocated call-out

		; In order to set the correct stack address here,
		; the last Int21 call to a usual function (such as
		; Int21.48) must've been made with the same stack
		; pointer as the Int21.4C call below gets.
		;
		; Update: dosemu2 does weird things to the stack.
		;  In particular, it inserts an additional iret
		;  frame depending on some conditions.
		; Only the interrupt 21h subfunctions 00h, 26h,
		;  31h, 4Bh, and 4Ch are handled differently.
		;  As a workaround we can call service 4Bh as the
		;  last interrupt 21h function before terminating.
		; Refer to https://github.com/dosemu2/dosemu2/blob/d7402eec84478c051d25e7b26dd8515514c186e2/src/base/core/int.c#L1633-L1639
	mov byte [pspCommandLine - 1], 0
	mov dx, pspCommandLine - 1
				; just in case, ds:dx -> zero value byte
	mov ax, 4B7Fh		; 21.4B with invalid subfunction in al
				;  (note that FreeDOS masks off 80h)
	int 21h
@@:

	push word [pspStack]
	pop word [es:pspStack]	; set SP used by process termination

	mov ax, 4C00h
	int 21h			; terminate, and make the new PSP active
				; also handles freeing all memory allocated to the old PSP
				; also closes any handles >20 if PHT larger
				; also notifies resident software old PSP is no longer valid
.terminated:			; (ax, bx, es, ds, bp might be changed)
	mov ah, 51h
	int 21h
	mov ds, bx
	mov ah, 1Ah
	mov dx, 80h
	int 21h			; set DTA
	pop ax			; discard es
	mov es, bx		; => new PSP
	not byte [cs:relocated]
	pop cx			; = comloader size
	pop ax			; => comloader image source

%ifn _MZEXESUPPORT
	jmp load_not_relocate
%else
	rol byte [cs:relocating_is_exe], 1
	jnc load_not_relocate

	mov dx, es
	add dx, 10h		; => behind PSP

	mov ds, ax		; => at MZ exe header
	xor bx, bx		; -> at header
	push es
	mov cx, word [bx + exeRelocItems]
	push ds
	jcxz .donereloc
	mov si, word [bx + exeRelocTable]
				; ds:si -> reloc table
				;  (may overflow 64 KiB but starts within first)
	mov bp, ds
	add bp, word [bx + exeHeaderSize]
				; bp => exe image (after header)
.loopreloc:
	mov ax, si		; preserve upper 12 bits
	and si, 15		; isolate low 4 bits
	shr ax, 1
	shr ax, 1
	shr ax, 1
	shr ax, 1		; divide by 16
	mov di, ds
	add di, ax		; => normalised relocation table entry
	mov ds, di
	lodsw			; load offset
	xchg di, ax		; di = offset
	lodsw			; load segment
	add ax, bp		; => relocation entry in exe image (after header)
	mov es, ax		; es:di -> relocation entry
	add word [es:di], dx	; relocate (with dx => behind PSP)
	loop .loopreloc		; loop for all relocations
.donereloc:
	pop ds			; => exe header
	mov bp, word [bx + exePages]
	mov cl, 5
	shl bp, cl		; = how many paragraphs in header + image
	mov ax, word [bx + exeHeaderSize]
	sub bp, ax		; = how many paragraphs in image
	jbe error_format
		; lMS-DOS doesn't ever use exeExtraBytes.
		;  we can ignore it likewise.
	mov cx, ds
	add ax, cx		; => exe image
	jc error_format
	mov cx, bp
	pop es			; => PSP
	jmp load_exe_relocated
%endif

.unable:
	jcxz @F
	mov es, cx
	mov ah, 49h
	int 21h
@@:

	pop bx
	mov ax, 5801h
	int 21h

	pop bx
	mov ax, 5803h
	int 21h

	pop es
	pop cx
	pop ax
load_not_relocate:
%endif
%if _MZEXESUPPORT
	mov dx, es
	add dx, 10h		; => behind PSP
	call movp

	mov ds, dx		; => at MZ exe header if any
	xor bx, bx		; -> at header
	cmp word [bx + exeSignature], "MZ"
	je .load_exe
	cmp word [bx + exeSignature], "ZM"
	jne .load_com
.load_exe:
	push es
	mov cx, word [bx + exeRelocItems]
	push ds
	jcxz .donereloc
	mov si, word [bx + exeRelocTable]
				; ds:si -> reloc table
				;  (may overflow 64 KiB but starts within first)
	mov bp, dx
	add bp, word [bx + exeHeaderSize]
				; bp => exe image (after header)
.loopreloc:
	mov ax, si		; preserve upper 12 bits
	and si, 15		; isolate low 4 bits
	shr ax, 1
	shr ax, 1
	shr ax, 1
	shr ax, 1		; divide by 16
	mov di, ds
	add di, ax		; => normalised relocation table entry
	mov ds, di
	lodsw			; load offset
	xchg di, ax		; di = offset
	lodsw			; load segment
	add ax, bp		; => relocation entry in exe image (after header)
	mov es, ax		; es:di -> relocation entry
	add word [es:di], dx	; relocate (with dx => behind PSP)
	loop .loopreloc		; loop for all relocations
.donereloc:
	pop ds			; => exe header
	mov bp, word [bx + exePages]
	mov cl, 5
	shl bp, cl		; = how many paragraphs in header + image
	mov ax, word [bx + exeHeaderSize]
	sub bp, ax		; = how many paragraphs in image
	jbe error_format
		; lMS-DOS doesn't ever use exeExtraBytes.
		;  we can ignore it likewise.
	mov cx, bp
	add ax, dx		; => exe image
	jc error_format
	pop es			; => PSP
load_exe_relocated: equ $
	add word [bx + exeInitCS], dx
	add word [bx + exeInitSS], dx
		; on stack: original ax
	push word [bx + exeInitCS]
	push word [bx + exeInitIP]
	push word [bx + exeInitSS]
	push word [bx + exeInitSP]
	push word [bx + exeMinAlloc]
	push word [bx + exeMaxAlloc]
	call movp

	add dx, cx		; => behind exe image at destination
	jc error_format
	pop bx			; max alloc
	pop ax			; min alloc
	cmp ax, bx		; minimum > maximum ?
	ja error_format
	test bx, bx		; maximum == 0 ?
	jz error_format		; not supported -->
	add bx, cx		; bx = maximum allocation size (maxalloc + image)
	jc .unlimited
	add bx, 10h		; account for PSP
	jnc @F
.unlimited:
	mov bx, -1		; if maximum requested, pass along bx = 0FFFFh
@@:
	add dx, ax		; dx => behind minimum allocation
	jc error_format

	push es			; preserve => PSP
%if _MCP
	rol byte [cs:relocated], 1
	jc .stub_free
%endif
	mov ax, cs
	cmp ax, dx
	jae .noreloc
	mov cx, ss
	sub cx, paras(COMLOADER_end - COMLOADER_start)
	cmp ax, cx
	jae error_memory
	cmp cx, dx
	jb error_format
	mov es, cx		; => comloader destination
	push cs
	pop ds			; => comloader source
	mov cx, words(COMLOADER_end - COMLOADER_start)
	mov si, cx		; = amount words
	add si, si		; = amount bytes
	mov di, si		; -> after last byte to move
	std
	cmpsw			; -> at last word to move
	jmp relocatecomloader	; do rep movsw and far branch to relocated

donerelocatedcomloader: equ $	; returns control flow here from relocator
	cld			; UP !
.noreloc:
	pop ax			; ax => PSP
				; bx = requested maximum allocation size

	pop di
	pop bp			; bp:di = stack

	push cs
	pop ds
	mov si, .enterstub	; -> stub source
	pop word [si + .enterstub_ip]
	pop word [si + .enterstub_cs]
				; set cs:ip
	pop word [si + .enterstub_ax]
				; set ax (from our entrypoint)

	mov es, bp		; => stack destination
	mov cx, .enterstub_size_w * 2
	sub di, cx		; -> space for stub
	shr cx, 1		; = amount words
	 push di
	rep movsw		; place stub
	 pop di			; bp:di -> stub
	mov es, ax		; es => PSP
	mov ds, ax		; ds => PSP
	cli
	mov ss, bp
	mov sp, di		; relocate stack
	sti
	lea ax, [di + .enterstub_entry]	; ss:ax -> stub entry
	push ss
	push ax			; -> stub's entry on stack
	mov di, 2		; es:di -> PSP word at [2]
	mov ah, 4Ah		; ah = 4Ah
	retf			; branch to there

	align 2, nop
.enterstub:
.enterstub_ax: equ $ - .enterstub
	dw 0
.enterstub_ip: equ $ - .enterstub
	dw 0
.enterstub_cs: equ $ - .enterstub
	dw 0

		; INP:	es = ds => PSP
		;	bx = maximum allocation size
		;	MCB already >= minimum allocation size
		;	ah = 4Ah
		;	di = 2
		;	ss:sp -> stack with ax, ip, cs, stub
.enterstub_entry: equ $ - .enterstub
		int3
	int 21h
	mov ax, es		; => PSP
	add ax, bx		; => behind allocation
	stosw			; store in word [PSP:2]
	pop ax			; pass through ax
	retf .enterstub_size - 6; branch to entry and pop off the enterstub
	nop	; Better cure for https://github.com/dosemu2/dosemu2/issues/2575
	align 2, nop
	endarea .enterstub
%endif	; _MZEXESUPPORT

%if _MCP
.stub_free:
	pop ax			; ax => PSP
	pop di
	pop bp			; bp:di = stack

	push cs
	pop ds
	mov si, .enterstub_free	; -> stub source
	pop word [si + .enterstub_free_ip]
	pop word [si + .enterstub_free_cs]
				; set cs:ip
	pop word [si + .enterstub_free_ax]
				; set ax (from our entrypoint)

	mov es, bp		; => stack destination
	mov cx, .enterstub_free_size_w * 2
	sub di, cx		; -> space for stub
	shr cx, 1		; = amount words
	 push di
	rep movsw		; place stub
	 pop di			; bp:di -> stub
	mov es, ax		; es => PSP
	mov ds, ax		; ds => PSP
	cli
	mov ss, bp
	mov sp, di		; relocate stack
	sti
	lea ax, [di + .enterstub_free_entry]	; ss:ax -> stub entry
	push es			; on stack: new PSP

	push ss
	push ax			; -> stub's entry on stack
	mov di, pspEndSegment	; es:di -> PSP word at [2]
	mov bx, 0
..@relocated_psp_size: equ $ - 2
	mov ax, es		; => PSP
	add ax, bx		; => behind allocation
	stosw			; store in word [PSP:2]
	mov bx, 0
..@original_psp: equ $ - 2
	mov es, bx		; => original PSP block
	mov ah, 49h		; ah = 49h
	retf			; branch to there

	align 2, nop
.enterstub_free:
.enterstub_free_ax: equ $ - .enterstub_free
	dw 0
.enterstub_free_ip: equ $ - .enterstub_free
	dw 0
.enterstub_free_cs: equ $ - .enterstub_free
	dw 0

		; INP:	ds => new PSP
		;	MCB already >= minimum allocation size and <= maximum
		;	ah = 49h
		;	es => old PSP
		;	ss:sp -> stack with es, ax, ip, cs, stub
.enterstub_free_entry: equ $ - .enterstub_free
		int3
	int 21h			; free original PSP
	pop es
	pop ax			; pass through ax
	retf .enterstub_free_size - 6; branch to entry and pop off the enterstub
	nop	; Better cure for https://github.com/dosemu2/dosemu2/issues/2575
	align 2, nop
	endarea .enterstub_free
%endif

%if _MZEXESUPPORT
.load_com:
 %if _MCP
	test cx, cx
	jz mcp_debug_transfer
 %endif
%else
 %if _MCP
	test cx, cx
	jz mcp_debug_transfer
 %endif

	mov ds, ax
	xor si, si		; ds:si -> source

%if 01
	cmp word [si + exeSignature], "MZ"
	je error_mz_exe_not_supported
	cmp word [si + exeSignature], "ZM"
	je error_mz_exe_not_supported
%endif

	push di
	rep movsw		; move to behind PSP
%endif

%if _MCP
	rol byte [cs:relocated], 1
	jnc .nonrelocated
 %if _MZEXESUPPORT
	mov di, 100h
 %else
	pop di
 %endif
	mov bx, [cs:..@relocated_psp_size]
	cmp bx, 1000h
	jbe @F
	mov bx, 1000h
@@:
	mov cl, 4
	shl bx, cl
	dec bx
	dec bx
	and word [es:bx], 0

				; es => PSP
		; on stack: original ax
	push es
	push di			; cs:ip
	push es
	push bx			; ss:sp

	push es			; preserve => PSP
	jmp .stub_free

.nonrelocated:
%endif

	mov bx, programstable	; cx:bx -> command program name table
				; (used by the associated COMLIST program)

	mov di, es
	add di, 1000h		; => behind area to be used by stack
	mov ax, cs		; => COMLOADER segment
	cmp ax, di		; COMLOADER starts above-or-equal stack end ?
	jae @F

	mov ax, ss
	sub ax, .to_reloc_size_p + programstable_size_p
	cmp ax, di
	jae .reloc

error_memory: equ $
	mov dx, msg.internal_error_memory
	jmp .error_exit

%if _MZEXESUPPORT
error_format: equ $
	mov dx, msg.internal_error_format
	jmp .error_exit
%elif 01
error_mz_exe_not_supported: equ $
	mov dx, msg.internal_error_mz
	jmp .error_exit
%endif

@@:
.to_reloc:
%if _MZEXESUPPORT
	mov di, 100h
%else
	pop di
%endif
	pop ax			; preserve original ax

	push es
	cli
	pop ss
	xor sp, sp		; full 64 KiB's stack
	sti
	xor si, si		; si = 0
	push si			; 0 word on stack

	 push es
	 pop ds			; ds = es = ss = cs = PSP

	mov cx, cs		; => name table

	push es
	push di			; -> PSP : 256
	retf
	endarea .to_reloc


.reloc:
	push es
	mov es, ax
	xor di, di
	mov cx, words(fromparas(.to_reloc_size_p))
	push cs
	pop ds
	mov si, .to_reloc
	rep movsw
	mov si, bx
	mov bx, di
	mov cx, words(fromparas(programstable_size_p))
	rep movsw
	pop es
	push ax
	push cx
	retf


..@error_unknown_name_given:
	push cs
	pop ds
	mov dx, msg.intro	; -> .msg
	mov ah, 09h
	int 21h			; display
	mov dx, msg.unknown_name_given

.error_exit:
	push cs
	pop ds
	mov ah, 09h
	int 21h
	mov ax, 4C01h
	int 21h


%if _MCP
mcp_debug_transfer:
	pop ax			; drive validity flag
	push es
	pop ds
	push es
	mov bx, 256+64
	push bx
	retf
%endif


%if _MZEXESUPPORT || _MCP
		; Move paragraphs
		;
		; INP:	ax:0-> source
		;	dx:0-> destination
		;	cx = number of paragraphs
		; CHG:	-
		; Note:	Doesn't work correctly on HMA; doesn't always wrap to LMA either.
		;	Do not provide a wrapped/HMA source or destination!
movp:
	push cx
	push ds
	push si
	push es
	push di

	cmp ax, dx		; source above destination ?
	ja .up			; yes, move up (forwards) -->
	je .return		; same, no need to move -->
	push ax
	add ax, cx		; (expected not to carry)
	cmp ax, dx		; end of source is above destination ?
	pop ax
	ja .down		; yes, move from top down -->
	; Here, the end of source is below-or-equal the destination,
	;  so they do not overlap. In this case we prefer moving up.

.up:
	push ax
	push dx
.uploop:
	mov ds, ax
	mov es, dx
	xor di, di
	xor si, si		; -> start of segment
	sub cx, 1000h		; 64 KiB left ?
	jbe .uplast		; no -->
	push cx
	mov cx, 10000h /2
	rep movsw		; move 64 KiB
	pop cx
	add ax, 1000h
	add dx, 1000h		; -> next segment
	jmp short .uploop	; proceed for more -->
.uplast:
	add cx, 1000h		; restore counter
	shl cx, 1
	shl cx, 1
	shl cx, 1		; *8, paragraphs to words
	rep movsw		; move last part
	pop dx
	pop ax
	jmp short .return

.down:
	std			; _AMD_ERRATUM_109_WORKAROUND as below
.dnloop:
	sub cx, 1000h		; 64 KiB left ?
	jbe .dnlast		; no -->
	push ax
	push dx
	add ax, cx
	add dx, cx
	mov ds, ax		; -> 64 KiB not yet moved
	mov es, dx
	pop dx
	pop ax
	mov di, -2
	mov si, di		; moved from last word down
	push cx
	mov cx, 10000h /2
	rep movsw		; move 64 KiB
	pop cx
	jmp short .dnloop	; proceed for more -->
.dnlast:
	add cx, 1000h		; restore counter
	shl cx, 1
	shl cx, 1
	shl cx, 1		; *8, paragraphs to words
	mov di, cx
	dec di
	shl di, 1		; words to offset, -> last word
	mov si, di
	mov ds, ax
	mov es, dx		; first segment correct


	numdef AMD_ERRATUM_109_WORKAROUND, 1
		; Refer to comment in init.asm init_movp.

%if _AMD_ERRATUM_109_WORKAROUND
	jcxz @FF
	cmp cx, 20
	ja @FF
@@:
	movsw
	loop @B
@@:
%endif
	rep movsw		; move first part
	cld
.return:
	pop di
	pop es
	pop si
	pop ds
	pop cx
	retn
%endif


DELIM1:
	CMP	AL, 32		; SKIP THESE GUYS
	je @F
	CMP	AL, ':'
	je @F
	CMP	AL, '='
	je @F
	CMP	AL, 9
	je @F
	CMP	AL, ','
	retn
DELIM2:
	CMP	AL, dl		; STOP ON THESE GUYS
	je @F
	CMP	AL, 13
@@:
	retn

SKIP_FILE:
	MOV	AH, 37h
	INT	21H			; dl = GET THE CURRENT SWITCH CHARACTER
FIND_DELIM:
	LODSB
	CALL	DELIM1
	JZ	GOTDELIM
	CALL	DELIM2
	JNZ	FIND_DELIM
GOTDELIM:
	DEC	SI
	retn

		; INP:	ds:si -> command line tail
		;	es => PSP
		;	es:5Ch -> first FCB to fill
		;	es:6Ch -> second FCB to fill
		; OUT:	bx = drive validity flags
		; CHG:	di, si, ax, dx
parse_dssi_cmdline_to_es_fcbs:
	MOV	DI, 5Ch
	MOV	AX, 2901h
	INT	21H
	cmp al, 1
	jne @F
	dec ax				; al = 0
@@:
	mov bl, al			; Indicate analysis of first parm
	CALL	SKIP_FILE

	MOV	DI, 6Ch
	MOV	AX, 2901h
	INT	21H
	cmp al, 1
	jne @F
	dec ax				; al = 0
@@:
	mov bh, al			; Indicate analysis of second parm
	retn

%if _MCP
relocate_to_uma:
	db 0
relocating_is_exe:
	db 0
relocated:
	db 0
%endif

msg:
.intro:	db "lDOS COMLOADER",36
.loading_before:
	db " - loading command program ",36
.loading_after:
	db 13,10,36
%if _MCP
.invalidcluflag:
	db "lDOS COMLOADER - Internal error: Invalid CLU flag!",13,10,36
%endif
.no_name_given:
	db 13,10,"No command program name specified!",13,10,36
.unknown_name_given:
	db 13,10,"Specified command program name not found!",13,10,36
.internal_error_memory:
	db 13,10,"Internal error, lacking memory for nonrelocated stack."
	db 13,10,36
%if _MZEXESUPPORT
.internal_error_format:
	db 13,10,"Internal error, MZ exe has invalid header or too large."
	db 13,10,36
%elif 01
.internal_error_mz:
	db 13,10,"Internal error, MZ exe not supported."
	db 13,10,36
%endif

	align 8
programstable:
..@base:
	comprogramlist COMMAND_LIST
%if _MCP
	dw -1, -1
%else
	dw 0, 0
%endif

	comprogrammessages COMMAND_LIST
	endarea programstable

shell_delta_exact equ SHELL_DELTA
nextcomprogram COMNONE, "", ""
%if _MCP
shell_sign:
	dd - (shell_delta_exact + shell_padding_length)
	db "FREECOM_SKIP"
shell_sign_size equ $ - shell_sign
%else
shell_sign_size equ 0
%endif

%assign COMLOADERSIZE (COMLOADER_end - COMLOADER_start + shell_sign_size)
%warning comloadersize=%[COMLOADERSIZE]
