
; Public Domain

; test install command: install; ; copyoutput uninstall

%include "lmacros3.mac"
%include "eld.mac"
%include "eldcall.mac"
%include "elddata.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 "Copy output to file."


	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 "CO"
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
	cmp al, '-'
	jne @F
	extcallcall skipcomma
@@:
	dec si

	mov dx, msg.copyoutput
internaldatarelocation
	extcallcall isstring?
	je @F
	mov dx, msg.co
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
	mov dx, relocateddata
linkdatarelocation msg.uninstall
	extcallcall isstring?
	je uninstall
	mov dx, msg.name
internaldatarelocation
	extcallcall isstring?
	je name
	mov dx, msg.on
internaldatarelocation
	extcallcall isstring?
	je on
	mov dx, msg.off
internaldatarelocation
	extcallcall isstring?
	je off
	mov dx, msg.toggle
internaldatarelocation
	extcallcall isstring?
	je toggle
	mov dx, msg.close
internaldatarelocation
	extcallcall isstring?
	je closecommand
	mov dx, msg.getinputmode
internaldatarelocation
	extcallcall isstring?
	je getinputmodecommand
	mov dx, msg.truncate
internaldatarelocation
	extcallcall isstring?
	je truncatecommand
	lodsb
	extcallcall chkeol
@@:
	extcallcall cmd3

name:
	extcallcall skipcomma
	extcallcall InDOS
	extcallcall yy_dos_parse_name
	; extcallcall yy_common_parse_name
	extcallcall chkeol
	call open_file
	push word [active]
internaldatarelocation
	mov byte [active], 0
internaldatarelocation -3
	xchg ax, word [handle]
internaldatarelocation
	xchg bx, ax
	call close
	mov bx, word [handle]
internaldatarelocation
	mov ax, 4202h
	xor cx, cx
	xor dx, dx
	int 21h
	pop ax
	mov byte [active], al
internaldatarelocation
	extcallcall cmd3


closecommand:
	mov bx, word [handle]
internaldatarelocation
	call close
	jc .error
	or word [handle], strict byte -1
internaldatarelocation -3
	extcallcall cmd3

.error:
	mov ax, 0E1Ah
	extcallcall setrc
	mov dx, msg.cannotclose
internaldatarelocation
	extcallcall putsz
	extcallcall cmd3


truncatecommand:
	mov dx, msg.truncate_not_open
internaldatarelocation
	mov bx, word [handle]
internaldatarelocation
	mov ax, 0E1Bh
	cmp bx, -1
	je .error

	mov dx, msg.truncate_indos
internaldatarelocation
	mov ax, 0E1Ch
	extcallcall InDOS
	jnz .error

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

	mov ah, 40h
		; cx still zero
	extcallcall _doscall
	mov dx, msg.truncate_error
internaldatarelocation
	mov ax, 0E1Dh
	jc .error
@@:
	extcallcall cmd3

.error:
	extcallcall setrc
	extcallcall putsz
	jmp @B


getinputmodecommand:
	extcallcall skipcomma
	extcallcall iseol?
	je .display
	dec si
	xor bx, bx
	mov dx, msg.fullonly
internaldatarelocation
	extcallcall isstring?
	je .have
	dec bx
	mov dx, msg.all
internaldatarelocation
	extcallcall isstring?
	je .have
	mov dx, msg.toggle
internaldatarelocation
	extcallcall isstring?
	je .havetoggle
.error:
	extcallcall error

.have:
	lodsb
	extcallcall chkeol
	mov byte [getinputmode], bl
internaldatarelocation
	extcallcall cmd3

.havetoggle:
	lodsb
	extcallcall chkeol
	not byte [getinputmode]
internaldatarelocation
	extcallcall cmd3

.display:
	mov dx, msg.mode
internaldatarelocation
	extcallcall putsz
	mov dx, msg.mode_fullonly
internaldatarelocation
	rol byte [getinputmode], 1
internaldatarelocation
	jnc @F
	mov dx, msg.mode_all
internaldatarelocation
@@:
	extcallcall putsz
	extcallcall cmd3


close:
	cmp bx, -1
	je @F
	extcallcall InDOS
	stc
	jnz @F
	mov ah, 3Eh
	extcallcall _doscall
	clc
@@:
	retn

on:
	mov byte [active], 0FFh
internaldatarelocation -3
	extcallcall cmd3

off:
	mov byte [active], 00h
internaldatarelocation -3
	extcallcall cmd3

toggle:
	not byte [active]
internaldatarelocation
	extcallcall cmd3


		; INP:	ds:bx -> filename
		; OUT:	File opened,
		;	 ax = file handle
		; STT:	ds = es = ss = debugger data selector/segment
open_file:
	mov di, bx
	call .setup_opencreate			; ds:si -> pathname
	mov ax, 716Ch				; LFN open-create
	push di
	xor di, di				; alias hint
	stc
	extcallcall _doscall
	pop di
	jnc .got		; LFN call succeeded -->

		; Early case for no-LFN-interface available.
	; cmp ax, 1
	; je .try_sfn
	cmp ax, 7100h
	je .try_sfn

	extcallcall yy_check_lfn
	jnc .error		; if LFN interface is available, actual error
				; if LFN interface is not available, try SFN

.try_sfn:
	call .setup_opencreate
	mov ax, 6C00h				; Open-create
	stc
	extcallcall _doscall
	jnc .got

	cmp ax, 1
	je .try_old_open
	cmp ax, 6C00h
	jne .error

.try_old_open:
	mov al, bl				; access and sharing modes
	mov ah, 3Dh				; Open
	mov dx, si				; -> filename
	stc
	extcallcall _doscall
	jnc .got
	cmp ax, 2				; file not found ?
	jne .error				; no, treat as error -->

	mov ah, 3Ch
	stc
	extcallcall _doscall			; try to create new file
	jnc .got

.error:
	mov ax, 0E1Eh
	extcallcall setrc
	mov dx, msg.error_file_open
internaldatarelocation
	extcallcall putsz
	extcallcall cmd3

.setup_opencreate:
	mov si, di				; -> filename
	mov bx, 0110_0000_0010_0010b		; Auto-commit, no int 24h
						; DENY WRITE, Read-write
	xor cx, cx				; create attribute
	mov dx, 0000_0000_0001_0001b		; create / open, no truncate
.got:
	retn


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


uninstall:
	lodsb
	extcallcall chkeol

	mov bx, word [handle]
internaldatarelocation
	call close
	jc .error
	or word [handle], strict byte -1
internaldatarelocation -3


	call get_es_ext

	push es
	pop ds

	mov si, hooktable
internaldatarelocation
	lframe
	lenter
	lvar word, table
	 push si

.loop_table:
	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:
	add si, HOOKTABLE_size
	mov word [bp + ?table], si
	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
@@:
	lleave
	push ss
	pop ds
	extcallcall putsz
	extcallcall cmd3	; return

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


puts_getline_handler:
.:
	jmp strict short .entry
.chain:
	extcall puts_getline_ext_done, required
				; must NOT be extcallcall
	times 10 - ($ - .) nop
.entry:
	cmp bl, 1
	ja .chain		; > 1 = unknown, reserved -->
	jb @F			; 0, service 0Ah result always written -->
				; 1, getinput result
	rol byte [getinputmode], 1
internaldatarelocation
	jc .chain		; mode enabled: skip write of full getinput result
@@:
	mov si, relocateddata + 1
linkdatarelocation line_in
	xor ax, ax
	lodsb
	mov dx, si
	call write
	jmp .chain


puts_copyoutput_handler:
.:
	jmp strict short .entry
.chain:
	extcall puts_copyoutput_ext_done, required
				; must NOT be extcallcall
	times 10 - ($ - .) nop
.entry:
	rol byte [getinputmode], 1
internaldatarelocation
	jc @F			; mode enabled: ignore in_getinput flag -->
	rol byte [relocateddata], 1
linkdatarelocation in_getinput
	jc .end			; mode disabled and in_getinput: skip -->
@@:
	call write
.end:
	clc
	jmp .chain

write:
	push ax
	push bx
	push cx

	rol byte [active], 1
internaldatarelocation
	jnc .end
	cmp word [handle], strict byte -1
internaldatarelocation -3
	je .end
	extcallcall InDOS
	jnz .end

	mov cx, ax		; cx = length
	mov bx, word [handle]
internaldatarelocation
	mov ah, 40h

	push es
	pop ds			; ds:dx -> text
	extcallcall ispm
	jnz .86
subcpu 286
	push ds
	call selector_to_segment; pass ds as segment
	push word 21h
	extcall intcall_ext_return_es, PM required
	pop ax
	pop ax
subcpureset
	db __TEST_IMM16		; (skip int)
.86:
	int 21h
	 push ss
	 pop ds

.end:
	pop cx
	pop bx
	pop ax
	retn


		; INP:	word [ss:sp] = selector to access
		; OUT:	word [ss:sp] = segment value to use for access
		; CHG:	-
selector_to_segment:
	lframe near
	lpar word,	in_selector_out_segment
	lpar_return
	lenter

	extcallcall ispm
				; is it PM ?
	jnz .ret		; no, 86M --> (selector == segment)

subcpu 286
	push ax
	push bx
	push cx
	push dx

	mov bx, word [bp + ?in_selector_out_segment]
	mov ax, 6
	int 31h			; get segment base to cx:dx
	shr dx, 4
	shl cx, 12
	or dx, cx
	mov word [bp + ?in_selector_out_segment], dx

	pop dx
	pop cx
	pop bx
	pop ax
subcpureset

.ret:
	lleave
	lret


	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

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

	align 2, db 0
hooktable:
		; command last so uninstall abort will leave command installed
	istruc HOOKTABLE
at htEntry,		dw puts_getline_handler
internalcoderelocation
at htHandler,		dw relocateddata
linkdatarelocation ext_puts_getline_handler
at htInstalled,		dw 0
	iend
	istruc HOOKTABLE
at htEntry,		dw puts_copyoutput_handler
internalcoderelocation
at htHandler,		dw relocateddata
linkdatarelocation ext_puts_copyoutput_handler
at htInstalled,		dw 0
	iend
	istruc HOOKTABLE
at htEntry,		dw command
internalcoderelocation
at htHandler,		dw relocateddata
linkdatarelocation ext_command_handler
at htInstalled,		dw 0
	iend
hooktable_end:


	align 2, db 0
handle:			dw -1
active:			db -1
getinputmode:		db 0		; 0 = full only, 0FFh = all


msg:
.copyoutput:		asciz "COPYOUTPUT"
.co:			asciz "CO"
.name:			asciz "NAME"
.on:			asciz "ON"
.off:			asciz "OFF"
.getinputmode:		asciz "GETINPUTMODE"
.fullonly:		asciz "FULLONLY"
.all:			asciz "ALL"
.toggle:		asciz "TOGGLE"
.close:			asciz "CLOSE"
.truncate:		asciz "TRUNCATE"
.truncate_not_open:	asciz "COPYOUTPUT cannot truncate file, no file is open!",13,10
.truncate_indos:	asciz "COPYOUTPUT cannot truncate file! DOS not available.",13,10
.truncate_error:	asciz "COPYOUTPUT truncate returned error!",13,10
.mode:			asciz "COPYOUTPUT GETINPUT mode: "
.mode_fullonly:		asciz "Only full submitted lines are written.",13,10
.mode_all:		asciz "All output of getinput is written.",13,10
.error_file_open:	asciz "COPYOUTPUT file open/create failed!",13,10
.cannotclose:		asciz "COPYOUTPUT file close failed! DOS not available.",13,10
.uninstall_done:	db "COPYOUTPUT uninstalled."
%if _ELD_RECLAIM_HINT
			db " (Don't forget to use reclaim.eld)"
%endif
			asciz 13,10
.uninstall_error:	asciz "COPYOUTPUT unable to uninstall!",13,10

uinit_data: equ $

.installed:	asciz "COPYOUTPUT installed.",13,10
.help:		db "Install this ELD using an INSTALL keyword.",13,10
		db 13,10
		db "Run with COPYOUTPUT NAME <filenametowrite>",13,10
		db "Run with COPYOUTPUT ON to enable writing. (Enabled by default.)",13,10
		db "Run with COPYOUTPUT OFF to disable writing.",13,10
		db "Run with COPYOUTPUT TOGGLE to toggle writing.",13,10
		db "Run with COPYOUTPUT GETINPUTMODE ALL to write all getinput text.",13,10
		db "Run with COPYOUTPUT GETINPUTMODE FULLONLY to write only full. (Default.)",13,10
		db "Run with COPYOUTPUT GETINPUTMODE TOGGLE to toggle mode.",13,10
		db "Run with COPYOUTPUT GETINPUTMODE to display mode.",13,10
		db "Run with COPYOUTPUT TRUNCATE to truncate file.",13,10
		db "Run with COPYOUTPUT CLOSE to close file.",13,10
		db "Run with COPYOUTPUT 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 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

.loop_table:
	mov bx, word [si + htHandler]; -> handler
	mov bx, word [bx]	; -> prior
	mov di, word [si + htEntry]	; -> our handler
	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:
	mov bx, word [si + htHandler]; -> handler
	mov ax, word [si + htEntry]
	mov word [bx], ax	; -> our entrypoint
	not byte [si + htInstalled]

.next_table:
	sub si, HOOKTABLE_size
	cmp si, strict word hooktable
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
