
; Public Domain

; test install command: install; with header d 100 l 10; with header uninstall
; test run command: ; .; .

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

	numdef TOP, 0		; support WITH TOP command prefix
	numdef SSNODUMP, 1	; support WITH NODUMP command prefix

%assign _CATCHINT0C 0
%assign _CATCHINT0D 0
%assign _CATCHINTFAULTCOND 0
%assign _DEBUG 0
%assign _DELAY_BEFORE_BP 0
%assign _DHIGHLIGHT 0
%assign _GETLINEHIGHLIGHT 0
%assign _IMMASM 0
%assign _INPUT_FILE_BOOT 0
%assign _INPUT_FILE_HANDLES 0
%assign _MS_0RANGE_COMPAT 0
%assign _PM 0
%assign _RH 0
%assign _SYMBOLIC 0
%assign _VXCHG 0
%include "options.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
at eldhxHelpOffset,		dd DATAOFFSET + msg.help - datastart
header_extension_end:
	iend

description:		asciz "Provide WITH HEADER/TRAILER command prefixes."


	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 "WITH hdr"
at eldiListing,		asciz _ELD_LISTING
	iend


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


	usesection CODE

command:
	jmp strict short .entry
.chain:
	extcall cmd3_not_ext, required	; must NOT be extcallcall
	times 10 - ($ - command) nop
.entry:
	push si
	dec si

	mov dx, msg.with
internaldatarelocation
	extcallcall isstring?
	je @F
.transfer_to_chain:
	pop si
	dec si
	lodsb
	jmp .chain

@@:
	extcallcall skipcomma
	dec si
reloc2	mov word [relocateddata], relocateddata
linkdatarelocation lastcmd, -4
linkdatarelocation dmycmd
%if _TOP || _SSNODUMP
	mov cx, relocateddata
linkdatarelocation options2
%endif
	mov bx, opt2_db_header | opt2_dw_header | opt2_dd_header
	mov dx, msg.header
internaldatarelocation
	extcallcall isstring?
	je @F
	mov bx, opt2_db_trailer | opt2_dw_trailer | opt2_dd_trailer
	mov dx, msg.trailer
internaldatarelocation
	extcallcall isstring?
%if _TOP
	je @F
	mov cx, relocateddata
linkdatarelocation options
	mov bx, cpdepchars
	mov dx, msg.top
internaldatarelocation
	extcallcall isstring?
%endif
%if _SSNODUMP
	je @F
	mov cx, relocateddata + 2
linkdatarelocation options
	mov bx, ss_no_dump >> 16
	mov dx, msg.nodump
internaldatarelocation
	extcallcall isstring?
%endif
	jne .transfer_to_chain
@@:
	extcallcall skipcomma
	dec si
	push si
	mov dx, relocateddata
linkdatarelocation msg.uninstall
	extcallcall isstring?
	jne .ours
	extcallcall skipwhite
	extcallcall iseol?
	jne .ours
	pop ax
	pop ax
	jmp uninstall
.ours:
	pop si
	pop ax
	extcallcall skipcomma

%if _TOP || _SSNODUMP
	xchg cx, bx
	mov dx, cx
	and dx, word [bx]		; get originals
	or word [bx], cx		; set our flags

	sub bx, strict word relocateddata
linkdatarelocation options
%else
	mov dx, bx
	and dx, word [relocateddata]	; get originals
linkdatarelocation options2
	or word [relocateddata], bx	; set our flags
linkdatarelocation options2
%endif

	rol byte [inprogress], 1	; already in progress ?
internaldatarelocation
	jnc @F				; no -->

%if _TOP || _SSNODUMP
	mov ax, word [word mask + bx]	; get old mask
internaldatarelocation
	not ax				; bits not yet set
	and dx, ax			; originals only from bits not yet set
	or word [word mask + bx], cx	; or in new mask
internaldatarelocation
	or word [word original + bx], dx; or in new originals
internaldatarelocation
	jmp @FF

@@:
	xor ax, ax
	mov word [mask + 0], ax
internaldatarelocation
	mov word [mask + 2], ax
internaldatarelocation
	mov word [mask + 4], ax
internaldatarelocation
	mov word [mask + 6], ax
internaldatarelocation
	mov word [original + 0], ax
internaldatarelocation
	mov word [original + 2], ax
internaldatarelocation
	mov word [original + 4], ax
internaldatarelocation
	mov word [original + 6], ax
internaldatarelocation

	mov word [word mask + bx], cx	; set mask
internaldatarelocation
	mov word [word original + bx], dx
internaldatarelocation			; set originals
@@:
%else
	mov cx, word [mask]		; get old mask
internaldatarelocation
	not cx				; bits not yet set
	and dx, cx			; originals only from bits not yet set
	or word [mask], bx		; or in new mask
internaldatarelocation
	or word [original], dx		; or in new originals
internaldatarelocation
	jmp @FF

@@:
	mov word [mask], bx		; set mask
internaldatarelocation
	mov word [original], dx		; set originals
internaldatarelocation
@@:
%endif

	rol byte [inprogress], 1	; already in progress ?
internaldatarelocation
	jc @F				; yes, do not inject again -->
	mov cx, .inject
internalcoderelocation
	xchg cx, word [relocateddata]	; inject us
linkdatarelocation ext_inject_handler
	mov word [inject_original], cx	; remember prior
internaldatarelocation
@@:

%if _TOP || _SSNODUMP
	dec si
	lodsb
%endif

%if 0
	call get_es_ext
	setopt [es:code + eldiFlags], eldifResident
internalcoderelocation -3		; mark block as resident
	 push ss
	 pop es
%else
	mov byte [inprogress], -1	; remember we are in progress
internaldatarelocation -3
%endif

	jmp word [relocateddata]	; cannot be zero. may re-enter us
linkdatarelocation ext_command_handler

.inject:
	mov cx, word [inject_original]
internaldatarelocation

%if 0
	call get_es_ext
	clropt [es:code + eldiFlags], eldifResident
internalcoderelocation -3		; mark block as free
	 push ss
	 pop es
%else
	mov byte [inprogress], 0
internaldatarelocation -3
%endif

%if _TOP || _SSNODUMP
	push si
	xor si, si
.resetloop:
	mov dx, word [word mask + si]
internaldatarelocation
	not dx
	mov bx, word [word original + si]
internaldatarelocation
	and word [word relocateddata + si], dx
linkdatarelocation options
	or word [word relocateddata + si], bx
linkdatarelocation options
	inc si
	inc si
	cmp si, 8
	jb .resetloop
	pop si
%else
	mov dx, word [mask]
internaldatarelocation
	not dx
	mov bx, word [original]
internaldatarelocation
	and word [relocateddata], dx
linkdatarelocation options2
	or word [relocateddata], bx
linkdatarelocation options2
%endif

	jcxz .notanotherinject
	jmp cx

.notanotherinject:
	extcall cmd3_not_inject


%if 0
get_es_ext:
	mov es, word [relocateddata]
linkdatarelocation extdssel
	extcall ispm
	jz @F
	mov es, word [relocateddata]
linkdatarelocation extseg
@@:
	retn
%endif


uninstall:
	rol byte [inprogress], 1
internaldatarelocation
	jc .error

	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


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
	mov dx, msg.help
internaldatarelocation
	extcall putsz
@@:
	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


	usesection DATA
inprogress:	db 0

msg:
.uninstall_done:	db "WITH HEADER command uninstalled."
%if _ELD_RECLAIM_HINT
			db " (Don't forget to use reclaim.eld)"
%endif
			asciz 13,10
.uninstall_error:	asciz "WITH HEADER command unable to uninstall!",13,10
.with:		asciz "WITH"
.header:	asciz "HEADER"
.trailer:	asciz "TRAILER"
%if _TOP
.top:		asciz "TOP"
%endif
%if _SSNODUMP
.nodump:	asciz "NODUMP"
%endif

uinit_data: equ $

.installed:	asciz "WITH HEADER command installed.",13,10
.help:		db "WITH HEADER command",13,10
		db 13,10
		db "Install using INSTALL parameter to ELD.",13,10
%if _TOP
		db "Run D command with a WITH HEADER, WITH TRAILER, or WITH TOP prefix.",13,10
%else
		db "Run D command with a WITH HEADER or WITH TRAILER prefix.",13,10
%endif
%if _SSNODUMP
		db "Run S command with a WITH NODUMP prefix.",13,10
%endif
		db "Uninstall with WITH HEADER UNINSTALL.",13,10
		asciz
%if _TOP || _SSNODUMP
.erroroptions:	asciz "Unable to install WITH HEADER command, unexpected options layout!",13,10
%endif

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

	absolute uinit_data
	alignb 2
%if _TOP || _SSNODUMP
mask:		resd 2
original:	resd 2
%else
mask:		resw 1
original:	resw 1
%endif
inject_original:resw 1


	alignb 16
uinit_data_end:
resident_data_end:
resident_data_size equ resident_data_end - datastart

%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

install:
	lodsb
	extcall chkeol

	houdini

%if _TOP || _SSNODUMP
	mov ax, relocateddata
linkdatarelocation options2
	sub ax, strict word relocateddata
linkdatarelocation options
	cmp ax, 4
	je @F

	mov ax, 0E5Dh
	extcall setrc
	mov dx, msg.erroroptions
internaldatarelocation
	extcall putsz
	mov ax, -3
	retf

@@:
%endif
	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

%if (transient_data_size - resident_data_size) > 0
	mov ax, transient_data_size - resident_data_size
	sub word [es:code + eldiEndData], ax
internalcoderelocation		; adjust size
	sub word [relocateddata], ax
linkdatarelocation extdata_used	; adjust size
%endif

	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


%include "eldlink.asm"

	align 16
code_size equ $ - code
