
; Public Domain

; test install command: install; dhm; dhm uninstall
; test run command: ; .; .

%include "lmacros3.mac"
%include "eld.mac"
%include "eldcall.mac"
%include "elddata.mac"
%include "hmcb.mac"

	cpu 8086

	addsection RELOCATEDDATA, nobits vstart=_ELD_RELOC_VSTART
relocateddata:

	addsection HEADER, start=0

	istruc ELD_HEADERX
at eldhxHeader
		; ELD executable header
	istruc ELD_HEADER
at eldhSignature,	db "ELD1"
			db 0,0,0
			db 26
at eldhCodeOffset,	dd CODEOFFSET
at eldhCodeImageLength,	dw code_size
at eldhCodeAllocLength,	dw 0
at eldhDataOffset,	dd DATAOFFSET
at eldhDataImageLength,	dw data_size
at eldhDataAllocLength,	dw total_data_size - data_size
at eldhCodeEntrypoint,	dw linker - code
at eldhReserved
at eldhExtensionSize,	dw header_extension_end - $$
	iend
at eldhxDescriptionOffset,	dd description
PUT_ELDHX_DATETIME_OFFSET
header_extension_end:
	iend

description:		asciz "Provide DHM (Dump HMA MCBs) command."


	align 16, db 0

CODEOFFSET equ $ - $$
	addsection CODE, follows=HEADER vstart=_ELD_CODE_VSTART
%define CODEFIXUP - code + 0
code:
code_start:
		; ELD instance header
	istruc ELD_INSTANCE
at eldiStartCode
at eldiEndCode
at eldiStartData
at eldiEndData
at eldiIdentifier,	fill 8, 32, db "DHM cmd"
at eldiListing,		asciz _ELD_LISTING
	iend


DATAOFFSET equ CODEOFFSET + code_size
	addsection DATA, follows=CODE vstart=_ELD_DATA_VSTART
%define DATAFIXUP - datastart + 0
datastart:
PUT_ELD_DATETIME


	usesection CODE

command:
	jmp strict short .entry
.chain:
	extcall cmd3_not_ext, required	; must NOT be extcallcall
	times 10 - ($ - command) nop
.entry:
	push si
	cmp al, '-'
	jne @F
	extcallcall skipcomma
@@:
	dec si
	mov dx, msg.dhm_command
internaldatarelocation
	extcallcall isstring?
	je @F
.transfer_to_chain:
	pop si
	dec si
	lodsb
	jmp .chain

@@:

.ours:
	pop ax
	extcallcall skipcomma
	dec si
reloc2	mov word [relocateddata], relocateddata
linkdatarelocation lastcmd, -4
linkdatarelocation dmycmd
	mov dx, relocateddata
linkdatarelocation msg.uninstall
	extcallcall isstring?
	je uninstall
	call hmcbout
	extcallcall cmd3

uninstall:
	lodsb
	extcallcall chkeol

	mov es, word [relocateddata]
linkdatarelocation extdssel
	extcallcall ispm
	jz @F
	mov es, word [relocateddata]
linkdatarelocation extseg
@@:
	push es
	pop ds
	xor bx, bx		; = 0 (no prior, modify ext_command_handler)
	mov di, command		; di -> us
internalcoderelocation
	mov si, word [ss:relocateddata]
linkdatarelocation ext_command_handler
				; si -> first
	test si, si		; none installed ?
	jz .error		; error -->

.loop:
	cmp di, si		; found ?
	je .bx			; yes, use bx -->
	mov bx, si		; bx -> prior handler
	lodsw			; skip entrypoint jmp strict short
	lodsb			; get first byte of chainer
	cmp al, 0E9h		; expecting jmp near ?
	jne .error		; no, error -->
	lodsw			; get rel16 displacement
	add si, ax		; -> next handler
	jmp .loop

.bx:
	test bx, bx		; any prior ?
	jnz .bxnz		; yes -->
	scasw			; skip entrypoint jmp strict short
	cmp byte [di], 0E8h	; is it a call to cmd3_not_ext ?
	jne @F			; no -->
				; yes, reset ext_command_handler to zero
.setbx:
	mov word [ss:relocateddata], bx
linkdatarelocation ext_command_handler
	jmp .done

@@:
	cmp byte [di], 0E9h	; validate
	jne .error		; failure -->
	inc di			; -> rel16 displacement
	mov bx, word [di]	; get displacement
	scasw			; -> after jmp near
	add bx, di		; -> next handler
	jmp .setbx		; set ext_command_handler to next

.bxnz:
	mov si, bx		; -> prior handler with us as downlink
	xchg di, si		; si -> ours, di -> prior
	cmpsw			; skip entrypoint jmp strict short
	movsb			; copy 0E8h/0E9h
	lodsw			; ax = near rel16 displacement
	add ax, si		; add in our base (= absolute offset)
	sub ax, di
	dec ax
	dec ax			; subtract new base (= relative displacement)
	stosw			; store new rel16 displacement
	movsw			; jmp strict short
	movsw			; linkcall target
	movsb			; trailer
.done:
	clropt [code + eldiFlags], eldifResident
internalcoderelocation -3	; mark block as free
	mov dx, msg.uninstall_done
internaldatarelocation
@@:
	push ss
	pop ds
	extcallcall putsz
	extcallcall cmd3	; return

.error:
	mov ax, 0E01h
	extcallcall setrc
	mov dx, msg.uninstall_error
internaldatarelocation
	jmp @B


%assign ELD 1
%assign _PM 1

hmcbout:
	xor bx, bx
	mov byte [founderror], bl
internaldatarelocation
	extcallcall skipcomma
	dec si
	mov dx, msg.keyword_force
internaldatarelocation
	extcallcall isstring?
	jne .check
	not bx
.check:
	extcallcall skipcomma
	dec si
	mov byte [force], bl
internaldatarelocation

%if 1
	xor bx, bx
	extcallcall skipcomma
	dec si
	mov dx, msg.keyword_header
internaldatarelocation
	extcallcall isstring?
	je .header
	mov dx, msg.keyword_table
internaldatarelocation
	extcallcall isstring?
	jne .nottable
.table:
	mov bl, -1
	db __TEST_IMM16		; skip mov
.header:
	mov bh, -1
.nottable:
	extcallcall skipcomma
	mov word [header_high_table_low], bx
internaldatarelocation
%else
	extcallcall skipwhite
%endif
	extcallcall iseol?
	je .get_dos_hmcb
	extcallcall getword
	extcallcall chkeol
	mov di, dx
	mov dx, -1
	jmp .no_dos

.get_dos_hmcb:
	rol byte [force], 1
internaldatarelocation
	jc @F

	extcallcall InDOS
	jz @F
	mov ax, 0E68h
	mov dx, msg.not_while_indos
internaldatarelocation
.setrc_putsz_cmd3:
	extcallcall setrc
	extcallcall putsz
	extcallcall cmd3

@@:
	mov ax, 4A04h			; get first HMCB
	extcallcall ispm
	jnz .rm

subcpu 286
	push word 0
	push word 2Fh
	extcall intcall_ext_return_es, PM required	; must NOT be extcallcall
	pop dx				; discard interrupt number
	pop dx				; get es
subcpureset
	jmp @F
.rm:
	int 2Fh
	mov dx, es
@@:
	push ss
	pop es

	test ax, ax
	jz @F
	mov ax, 0E69h
	mov dx, msg.not_supported
internaldatarelocation
	jmp .setrc_putsz_cmd3

@@:
.no_dos:
	cmp dx, -1
	je @F
	push di
	mov di, msg.not_valid.addr
internaldatarelocation
	xchg ax, dx
	extcallcall hexword
	scasw				; di += 2
	pop ax
	extcallcall hexword
	mov ax, 0E6Ah
	mov dx, msg.not_valid
internaldatarelocation
	jmp .setrc_putsz_cmd3

@@:
	mov si, di
%if ELD
	mov dx, msg.headertable
internaldatarelocation
	rol byte [header_high_table_low], 1
internaldatarelocation
	jc @F
	mov dx, msg.headerheader
internaldatarelocation
	rol byte [header_high_table_low + 1], 1
internaldatarelocation
	jnc @FF
@@:
	extcallcall putsz
@@:
%endif
.next:
	mov di, relocateddata
linkdatarelocation line_out
	push ds
	mov bx, -1
	extcallcall setds2bx
	mov cx, word [si + hmcbSignature]
	mov bx, word [si + hmcbOwner]
	mov dx, word [si + hmcbSize]

	mov ax, si
	extcallcall hexword		; offset address of MCB
%if ELD
	mov ah, 3
	call stosb_repeated
%else
	mov al, 32
	stosb
%endif
	mov ax, cx
	extcallcall hexword		; "MS" expected
%if ELD
	mov ah, 1
	call stosb_repeated
%else
	mov al, 32
	stosb
%endif
	mov ax, bx
	extcallcall hexword		; MCB owner
%if ELD
	mov ah, 1
	call stosb_repeated
%else
	mov al, 32
	stosb
%endif
	mov ax, dx
	extcallcall hexword		; MCB size in bytes

	mov al, 32
	stosb
	mov ax, dx		; ax = size in bytes
	push bx
	push ax
	push dx
	push cx
	xor dx, dx		; dx:ax = size in bytes
	mov cx, 1		; cx = 1, multiplier (get size in bytes)
	mov bx, 5+4		; bx = 5+4, width

	extcallcall disp_dxax_times_cx_width_bx_size.store
	pop cx
	pop dx
	pop ax
	pop bx

%if ELD
	mov ah, 1
	call stosb_repeated
%else
	mov al, 32
	stosb
%endif
	mov ax, word [si + hmcbNext]
	extcallcall hexword		; MCB next offset

%if ELD
	mov ah, 1
	call stosb_repeated
%else
	mov al, 32
	stosb
%endif
	push si
	push cx
	push dx

houdini

	test bx, bx
	jz .freemcb		; free MCBs have no name -->

	mov al, '"'
	stosb
	lea si, [si + hmcbName]
	lodsb
	test al, al		; empty name ?
	jz .emptyname		; yes -->

	mov cx, 8
	db __TEST_IMM8		; (skip lodsb)
.loopmcbchar:			; copy name of owner MCB
	lodsb
	cmp al, '"'
	jne @F
	mov ax, '\"'
	stosw
	jmp .nextmcbchar

@@:
	test al, al
	jz @F
	cmp al, 32
	jb .control
	cmp al, 127
	jb @F
.control:
	mov al, '.'
@@:
	stosb
.nextmcbchar:
	test al, al
	loopnz .loopmcbchar	; was not NUL and more bytes left ?
	test al, al
	jnz @F
	dec di
@@:
	mov al, '"'
	stosb
	jmp .namedone

.freemcb:
	mov si, msg.free
internaldatarelocation
	jmp @F

.emptyname:
	dec di
	mov si, msg.emptyname
internaldatarelocation
@@:
	push ds
	 push ss
	 pop ds
	extcallcall copy_single_counted_string
	pop ds
.namedone:

	 push bx
	 push ds
	push ss
	pop ds
	extcallcall putsline_crlf	; destroys ax,cx,dx,bx
	 pop ds
	 pop bx
	pop dx
	pop cx
	pop si

	cmp cx, "MS"
	je @F
	mov ax, msg.invalidsign
internaldatarelocation
	call display_error
@@:

	test si, 15
	jz @F
	mov ax, msg.invalidoffset
internaldatarelocation
	call display_error
	jmp @FF
@@:

	cmp si, 10h
	jae @F
	mov ax, msg.invalidoffset
internaldatarelocation
	call display_error
@@:

	test dl, 15
	jz @F
.invalidsize:
	mov ax, msg.invalidsize
internaldatarelocation
	call display_error
	jmp @FF
@@:

	mov ax, si
	add ax, dx
	jc .invalidsize
	add ax, HMCB_size
	jnc @F
	jnz .invalidsize
@@:

	cmp ax, word [si + hmcbNext]
	je @F
	mov ax, msg.sizemismatch
internaldatarelocation
	call display_error
@@:
	pop ds

.disp:
	xchg si, ax

	rol byte [founderror], 1
internaldatarelocation
	jc .end

	test si, si
	jnz .next

.end:
	retn


display_error:
	push ds
	push dx
	 push ss
	 pop ds
	xchg dx, ax
	extcallcall putsz
	mov byte [founderror], 0FFh
internaldatarelocation -3
	pop dx
	pop ds
	retn


%if 1
stosb_repeated:
	mov al, 32
	stosb
	rol byte [ss:header_high_table_low], 1
internaldatarelocation
	jnc .ret
	push cx
	xor cx, cx
	mov cl, ah
	rep stosb
	pop cx
.ret:
	retn
%endif


error:
	extcall error

	eldcall_dump_callcall ELDCALL_CALLCALL_LIST

endinstalled equ ($ + CODEFIXUP + 15) & ~15


start:
	mov bx, es
	 push ss
	 pop es
	call skipcomma
	dec si
	mov dx, relocateddata
linkdatarelocation msg.install
	call isstring?
	je install
	call hmcbout
@@:
	call uninstall_oneshot
	xor ax, ax
	retf


uninstall_oneshot:
	testopt [ss:relocateddata], 1
linkdatarelocation options7, -3
	jnz @F

	mov ax, word [cs:code + eldiEndCode]
internalcoderelocation
	sub ax, word [cs:code + eldiStartCode]
internalcoderelocation
	sub word [relocateddata], ax
linkdatarelocation extseg_used

	mov ax, word [cs:code + eldiEndData]
internalcoderelocation
	sub ax, word [cs:code + eldiStartData]
internalcoderelocation
	sub word [relocateddata], ax
linkdatarelocation extdata_used
@@:
	retn


install:
	lodsb
	extcall chkeol

	houdini
	mov es, bx		; => ext seg (writable)
	mov ax, endresident - endinstalled
	sub word [es:code + eldiEndCode], ax
internalcoderelocation		; adjust size
	sub word [relocateddata], ax
linkdatarelocation extseg_used	; adjust size
	mov bx, word [relocateddata]
linkdatarelocation ext_command_handler
				; -> prior
	mov di, command		; -> our handler
internalcoderelocation
	test bx, bx		; installing as first ?
	jz .only_first		; yes, simple --> (leave as extcall cmd3_not_ext)
	scasw			; skip entrypoint jmp strict short
	mov al, 0E9h		; = jmp near opcode
	stosb			; store
	xchg ax, bx		; ax -> next handler
	sub ax, di
	dec ax
	dec ax			; ax = ax - (di + 2)
	stosw			; store our downlink as rel16 displacement

.only_first:
	setopt [es:code + eldiFlags], eldifResident
internalcoderelocation -3	; mark block as resident
	mov word [relocateddata], command
linkdatarelocation ext_command_handler, -4
internalcoderelocation		; -> our entrypoint

	testopt [relocateddata], 4
linkdatarelocation options7, -3
	jnz @F
	mov dx, msg.installed
internaldatarelocation
	call putsz
@@:
	xor ax, ax
	retf


	usesection DATA
msg:
.uninstall_done:	db "DHM command uninstalled."
%if _ELD_RECLAIM_HINT
			db " (Don't forget to use reclaim.eld)"
%endif
			asciz 13,10
.uninstall_error:	asciz "DHM command unable to uninstall!",13,10
.dhm_command:		asciz "DHM"
.keyword_header:	asciz "HEADER"
.keyword_table:		asciz "TABLE"
.keyword_force:		asciz "FORCE"
.headerheader:	asciz "Ofs  Sign Own  Size     Bytes Next Name",13,10
		      ;9FFF 534D 0008 2100   132 KiB 0000 SC
.headertable:	asciz "Offset  Sign  Own   Size     Bytes  Next  Name",13,10
		      ;9FFF    534D  0008  2100   132 KiB  0000  SC
		      ;    0123    01    01    012       01    01
.not_while_indos:
		asciz "Not calling DOS while InDOS! Use FORCE to override.",13,10
.free:		counted "(free)"
.emptyname:	counted "(empty name)"
.not_supported:	asciz "DOS call 2F.4A04 not supported!",13,10
.not_valid:	db "DOS call 2F.4A04 returned ES:DI="
.not_valid.addr:asciz "----h:----h not valid!",13,10
.invalidsign:	asciz "Sign is invalid!",13,10
.invalidoffset:	asciz "Offset is invalid!",13,10
.invalidsize:	asciz "Size is invalid!",13,10
.sizemismatch:	asciz "Size doesn't match next offset!",13,10

uinit_data: equ $

msg.installed:	asciz "DHM command installed.",13,10

	align 16, db 0
init_data_end:
data_size equ $ - datastart

	absolute uinit_data

force:			resb 1
founderror:		resb 1
	alignb 2
header_high_table_low:	resw 1

	alignb 16
uinit_data_end:
resident_data_end:

%if uinit_data_end >= init_data_end
 total_data_size equ $ - datastart
%else
 total_data_size equ init_data_end - datastart
%endif
%assign _DATA_SIZE total_data_size

	usesection CODE

%include "eldlink.asm"

	align 16
code_size equ $ - code
