
; Public Domain

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

%include "lmacros3.mac"
%include "eld.mac"
%include "eldcall.mac"
%include "elddata.mac"
%include "mzheader.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
PUT_ELDHX_DATETIME_OFFSET
header_extension_end:
	iend

description:		asciz "Display information on successful L commands."


	align 16, db 0

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


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.linfo
internaldatarelocation
	extcallcall isstring?
	je .ours

%if 0
		; heuristic: these commands are possibly
		;  calling resident ELDs and unlikely to
		;  want to run program-loading L.
	mov dx, msg.ldmem
internaldatarelocation
	extcallcall isstring?
	je .pop_chain

	mov dx, msg.ldmemoth
internaldatarelocation
	extcallcall isstring?
	je .pop_chain
	lodsb
	cmp al, 'L'
	je .intercept
%else
		; better detection: require L to match as
		;  a string, so cannot mean any ELDs.
		;  implies that it is not handled if the user
		;  enters L with the address immediately behind
		;  the L without a blank or comma.
	mov dx, msg.l
internaldatarelocation
	extcallcall isstring?
	je .intercept
%endif
.pop_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
	mov dx, msg.probe
internaldatarelocation
	extcallcall isstring?
	je .probe
	mov dx, msg.file
internaldatarelocation
	extcallcall isstring?
	je .file
	lodsb
	extcallcall chkeol
.cmd3:
	extcallcall cmd3


.probe:
	call .parsequiet
	lodsb
	extcallcall chkeol
	test bx, bx
	jz @F
	cmp byte [80h], 0
	je .cmd3
@@:
	mov di, relocateddata
linkdatarelocation line_out
	call probe
	jmp .cmd3


.file:
	call .parsequiet
	lodsb
	extcallcall chkeol
	test bx, bx
	jz @F
	cmp byte [80h], 0
	je .cmd3
@@:
	call file
	jmp .cmd3


.parsequiet:
	extcallcall skipcomma
	dec si
	xor bx, bx
	mov dx, msg.quiet
internaldatarelocation
	extcallcall isstring?
	jne @F
	dec bx
@@:
	retn


.intercept:
	extcallcall skipcomma
	extcallcall iseol?
	je .plw2			; if no arguments
	extcallcall getaddr		; get buffer address into bx:(e)dx
	extcallcall skipcomm0
	extcallcall iseol?
	je .plw2			; if only one argument
	jmp .pop_chain

.plw2:
	houdini

	call file

	houdini
	mov si, hooktable.puts
internaldatarelocation
	call hook
	push ss
	pop es
	mov byte [failed], 0
internaldatarelocation -3

	rol byte [injecting], 1
internaldatarelocation
	jnc @F

	mov dx, msg.injectalready
internaldatarelocation
	extcallcall putsz
	jmp .pop_chain

@@:
	not byte [injecting]
internaldatarelocation
	mov ax, inject
internalcoderelocation
	xchg ax, word [relocateddata]
linkdatarelocation ext_inject_handler
	mov word [priorinject], ax
internaldatarelocation

	jmp .pop_chain


inject:
	mov byte [injecting], 0
internaldatarelocation -3

		; briefly inject the prior handler.
		;  if puts aborts the process, this
		;  will be called by cmd3 next.
		; otherwise we will retrieve it later
		;  and then branch to it, if nonzero.
	mov ax, word [priorinject]
internaldatarelocation
	mov word [relocateddata], ax
linkdatarelocation ext_inject_handler

	 push di
	houdini
	mov si, hooktable.puts
internaldatarelocation
	call unhook
	push ss
	pop ds
	push ss
	pop es
	 pop di

	rol byte [failed], 1
internaldatarelocation
	jnc @F
	mov dx, msg.failure
internaldatarelocation
	extcallcall putsz
	jmp .end

@@:
	mov dx, msg.success
internaldatarelocation
	extcallcall putsz

	call probe
.end:
		; get + clear inject handler and either run it
		;  or branch to cmd3_not_inject to continue.
	xor cx, cx
	xchg cx, word [relocateddata]
linkdatarelocation ext_inject_handler
	jcxz .notinject
	jmp cx

.notinject:
	extcall cmd3_not_inject


file:
	mov dx, msg.loading
internaldatarelocation
	extcallcall putsz
	mov dx, 80h
	extcallcall putsz
	mov dx, msg.linebreak
internaldatarelocation
	extcallcall putsz
	retn


probe:
	extcallcall InDOS
	jz @F
	mov ax, 0E44h
	extcallcall setrc
	mov dx, msg.indos
internaldatarelocation
.end_putsz:
	extcallcall putsz
	jmp .end

@@:
	extcallcall close_ext

	mov ax, 3D00h
	mov dx, 80h		; -> N/K pathname buffer
	int 21h
	jnc @F
	mov ax, 0E45h
	extcallcall setrc
	mov dx, msg.openerror
internaldatarelocation
	jmp .end_putsz

@@:
	mov word [relocateddata], ax
linkdatarelocation ext_handle
	xchg bx, ax

	lframe
	lvar fromwords(words(EXEHEADER_size)), buffer
	lenter
	mov cx, relocateddata
linkdatarelocation line_out
	neg cx
	add cx, di
	lvar word, endofprompt
	 push di
	mov ax, cx
	inc ax
	and al, ~1
	lvar word, lengthofprompt
	 push ax
	sub sp, ax
	mov di, sp
	mov si, relocateddata
linkdatarelocation line_out
	rep movsb

	mov di, relocateddata
linkdatarelocation line_out

	mov ax, 4202h
	xor cx, cx
	xor dx, dx
	extcallcall _doscall

	mov si, msg.1
internaldatarelocation
	extcallcall copy_single_counted_string
	extcallcall decdword

	mov si, msg.2
internaldatarelocation
	extcallcall copy_single_counted_string
	call hex_dword_as_needed

	mov ax, 4200h
	xor cx, cx
	xor dx, dx
	extcallcall _doscall

	lea dx, [bp + ?buffer]
	mov cx, EXEHEADER_size
	mov ah, 3Fh
	extcallcall _doscall
	jc .readerror
	cmp ax, cx
	jne .notmz
	mov ax, word [bp + ?buffer + exeSignature]
	cmp ax, "MZ"
	je .mz
	cmp ax, "ZM"
	jne .notmz
.mz:
	mov si, msg.3.mz
internaldatarelocation
	extcallcall copy_single_counted_string
	stosw
	extcallcall putsline_crlf

	mov di, relocateddata
linkdatarelocation line_out

	mov si, msg.mz.1
internaldatarelocation
	extcallcall copy_single_counted_string

	mov ax, word [bp + ?buffer + exeHeaderSize]
	mov dx, 16
	mul dx
	extcallcall decdword

	mov si, msg.mz.2
internaldatarelocation
	extcallcall copy_single_counted_string

	mov ax, word [bp + ?buffer + exeHeaderSize]
	extcallcall hexword
	mov al, '0'
	stosb

	mov si, msg.mz.3
internaldatarelocation
	extcallcall copy_single_counted_string

	mov ax, word [bp + ?buffer + exeExtraBytes]
	test ax, ax
	jz .full
	cmp ax, 512
	jbe @F
.full:
	mov ax, 512
@@:
	mov si, word [bp + ?buffer + exePages]
	xor dx, dx
	mov cx, 5
@@:
	shl si, 1
	rcl dx, 1
	loop @B

	sub si, word [bp + ?buffer + exeHeaderSize]
	sbb dx, 0

	mov cl, 4
@@:
	shl si, 1
	rcl dx, 1
	loop @B

	sub si, 512
	sbb dx, 0
	add ax, si
	adc dx, 0

	extcallcall decdword

	mov si, msg.mz.4
internaldatarelocation
	extcallcall copy_single_counted_string

	call hex_dword_as_needed
	mov ax, "h)"
	stosw

	jmp .putsline


.readerror:
	mov ax, 0E46h
	extcallcall setrc
	mov dx, msg.readerror
internaldatarelocation
	extcallcall putsz
	jmp .close

.notmz:
	mov si, msg.3.notmz
internaldatarelocation
	extcallcall copy_single_counted_string
.putsline:
	extcallcall putsline_crlf
.close:
	extcallcall close_ext

	mov di, relocateddata
linkdatarelocation line_out

	mov si, msg.psp.1
internaldatarelocation
	extcallcall copy_single_counted_string
	mov ax, word [relocateddata]
linkdatarelocation pspdbe
	extcallcall hexword

	mov si, msg.psp.2
internaldatarelocation
	extcallcall copy_single_counted_string
	dec ax
	xchg dx, ax
	extcallcall setes2dx
	mov ax, word [es:3]
	push ss
	pop es
	xor dx, dx
	mov cx, 16
	mov bx, 4+4
	extcallcall disp_dxax_times_cx_width_bx_size.store

	extcallcall putsline_crlf

.leave:
	mov di, relocateddata
linkdatarelocation line_out
	mov si, sp
	mov cx, word [bp + ?lengthofprompt]
	rep movsb
	mov di, word [bp + ?endofprompt]

	lleave
.end:
	retn


hex_dword_as_needed:
	xchg dx, ax
	test ah, ah
	jnz @F
	test al, al
	jz @FF
	extcallcall hexbyte
	jmp @FF
@@:
	extcallcall hexword
@@:
	xchg dx, ax
	extcallcall hexword
	retn


puts_handler:
.:
	jmp strict short .entry
.chain:
	extcall puts_ext_done, required	; must NOT be extcallcall
	times 10 - ($ - .) nop
.entry:
	test ax, ax
	jz @F
	mov cx, msg.dpmihooked.length
	cmp ax, cx
	jb .fail
	push si
	push di
	mov di, dx
	mov si, msg.dpmihooked
internaldatarelocation
	repe cmpsb
	pop di
	pop si
	je @F

.fail:
	mov byte [failed], 0FFh
internaldatarelocation -3
@@:
	clc
	jmp .chain


uninstall:
	lodsb
	extcallcall chkeol

	rol byte [injecting], 1
internaldatarelocation
	jc .error

	mov si, hooktable
internaldatarelocation
.loop_table:
	call unhook
	jc .error

	add si, HOOKTABLE_size
	cmp si, strict word hooktable_end
internaldatarelocation
	jb .loop_table


	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


unhook:
	call get_es_ext

	push es
	pop ds

	lframe
	lenter
	lvar word, table
	 push si
	rol byte [ss:si + htInstalled], 1
	jnc .next_table
	xor bx, bx		; = 0 (no prior, modify handler)
	mov di, word [ss:si + htEntry]	; di -> us
	mov si, word [ss:si + htHandler]; -> handler
	mov si, word [ss:si]	; 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 si, word [bp + ?table]
	mov si, word [ss:si + htHandler]; -> handler
	mov word [ss:si], bx
	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:
	mov si, word [bp + ?table]
	not byte [ss:si + htInstalled]

.next_table:
	db __TEST_IMM8		; NC, skip stc
.error:
	stc
	lleave
	retn


hook:
	call get_es_ext

	rol byte [si + htInstalled], 1
	jc .done
	mov bx, word [si + htHandler]; -> handler
	mov bx, word [bx]	; -> prior
	mov di, word [si + htEntry]	; -> our handler
	scasw			; skip entrypoint jmp strict short
	test bx, bx		; installing as first ?
	jnz .chain
		; Set downlink to an extcall cmd3_not_ext or puts_ext_done.
		;  If we're running in a repeated hook later (for puts)
		;  then the downlink may be stale and not point at the
		;  terminal puts_ext_done any longer. So need to re-init.
	mov al, 0E8h
	stosb			; reset downlink for repeated hook later
	mov ax, word [si + htDefaultRel16]
	jmp .store_rel16

.chain:
	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)
.store_rel16:
	stosw			; store our downlink as rel16 displacement

	mov bx, word [si + htHandler]; -> handler
	mov ax, word [si + htEntry]
	mov word [bx], ax	; -> our entrypoint
	not byte [si + htInstalled]
.done:
	retn


get_es_ext:
	mov es, word [ss:relocateddata]
linkdatarelocation extdssel
	extcallcall ispm
	jz @F
	mov es, word [ss:relocateddata]
linkdatarelocation extseg
@@:
	retn


	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


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

	struc HOOKTABLE
htEntry:		resw 1
htHandler:		resw 1
htInstalled:		resw 1
htDefaultRel16:		resw 1
	endstruc

	align 2, db 0
hooktable:
		; command last so uninstall abort will leave command installed
.puts:
	istruc HOOKTABLE
at htEntry,		dw puts_handler
internalcoderelocation
at htHandler,		dw relocateddata
linkdatarelocation ext_puts_handler
at htInstalled,		dw 0
	iend
.lastinstall:
	istruc HOOKTABLE
at htEntry,		dw command
internalcoderelocation
at htHandler,		dw relocateddata
linkdatarelocation ext_command_handler
at htInstalled,		dw 0
	iend
hooktable_end:

injecting:		db 0


msg:
.linfo:		asciz "LINFO"
%if 0
.ldmem:			asciz "LDMEM"
.ldmemoth:		asciz "LDMEMOTH"
%else
.l:			asciz "L"
%endif
.file:			asciz "FILE"
.probe:			asciz "PROBE"
.quiet:			asciz "QUIET"
.injectalready:		asciz "LINFO error: Already injecting.",13,10
.dpmihooked:		db "DPMI entry hooked"
.dpmihooked.length equ $ - .dpmihooked
.loading:		asciz "Loading file: "
.linebreak:		asciz 13,10
.success:		asciz "LINFO: Success",13,10
.failure:		asciz "LINFO: Failure",13,10
.indos:			asciz "LINFO cannot probe file while InDOS.",13,10
.openerror:		asciz "LINFO file open error!",13,10
.readerror:		asciz "LINFO file read error!",13,10
.1:			counted "LINFO, file size = "
.2:			counted " ("
.3.mz:			counted "h), EXE header signature = "
.3.notmz:		counted "h), no EXE header"
.mz.1:			counted "Header size = "
.mz.2:			counted " ("
.mz.3:			counted "h), image size = "
.mz.4:			counted " ("
.psp.1:			counted "PSP at segment = "
.psp.2:			counted "h, memory block size is "
.uninstall_done:	db "LINFO uninstalled."
%if _ELD_RECLAIM_HINT
			db " (Don't forget to use reclaim.eld)"
%endif
			asciz 13,10
.uninstall_error:	asciz "LINFO unable to uninstall!",13,10

uinit_data: equ $

.installed:	asciz "LINFO installed.",13,10
.help:		db "Install this ELD using an INSTALL keyword.",13,10
		db 13,10
		db "Running program-loading L commands will display info.",13,10
		db 13,10
		db "Run as LINFO FILE [QUIET] to display program load filename.",13,10
		db "Run as LINFO PROBE [QUIET] to probe program load file and PSP.",13,10
		db "(With QUIET an empty program load filename will lead to no output.)",13,10
		db 13,10
		db "Run with LINFO UNINSTALL to uninstall.",13,10
		asciz


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

	absolute uinit_data

	alignb 2
priorinject:	resw 1
failed:		resb 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
	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 si, hooktable_end - HOOKTABLE_size
internaldatarelocation
	push si
.loop_prepare:
	houdini
	mov bx, word [si + htEntry]
	mov bx, word [es:bx + 3]
	mov word [si + htDefaultRel16], bx
				; init for repeated hook later
	sub si, HOOKTABLE_size
	cmp si, strict word hooktable
internaldatarelocation
	jae .loop_prepare

	pop si
.loop_table:
	call hook
.next_table:
	sub si, HOOKTABLE_size
	cmp si, strict word hooktable.lastinstall
internaldatarelocation
	jae .loop_table

	setopt [es:code + eldiFlags], eldifResident
internalcoderelocation -3	; mark block as resident

	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
