
; Public Domain

; test install command: install; ; errfix 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
PUT_ELDHX_DATETIME_OFFSET
header_extension_end:
	iend

description:		asciz "Fix error message output."


	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 "ERRFIX"
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.errfix
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.debug
internaldatarelocation
	extcallcall isstring?
	je debug
	lodsb
	extcallcall chkeol
	extcallcall cmd3

debug:
	extcallcall skipcomma
	dec si
	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
	lodsb
	extcallcall chkeol
	mov dx, msg.debug_on
internaldatarelocation
	rol byte [active], 1
internaldatarelocation
	jc @F
	mov dx, msg.debug_off
internaldatarelocation
@@:
	extcallcall putsz
	extcallcall cmd3

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

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

toggle:
	lodsb
	extcallcall chkeol
	not byte [active]
internaldatarelocation
	extcallcall cmd3


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


uninstall:
	lodsb
	extcallcall chkeol

	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

	and word [ss:relocateddata], byte 0
linkdatarelocation indirect_array_errfix, -3
				; free the variable

	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, 2		; getinput calls for CO.ELD ?
	jb .chain		; yes, just chain -->
	cmp bl, 4		; getline done ?
	jb .reset		; yes, reset our array -->
	cmp bl, 5		; error (5 = have column, 4 = have address) ?
	jbe .error
	cmp bl, 6
	ja .chain		; no, unknown function, chain -->
.movedown:
		; INP:	bl = 6
		;	byte [line_in + 1] = length
		;	es:di -> line_in + 2
		;	ds:si -> higher in line_in
		;	ax = length of data to move down (includes CR)
		; CHG:	cx, bh, dx
		; STT:	ds = es = ss
		;	UP, EI
	push si
	push di
	mov dx, array
internaldatarelocation
	sub dx, strict word relocateddata + 2
linkdatarelocation line_in
	add si, dx		; source - line_in+2 + array
	add di, dx		; destination - line_in+2 + array
	mov cx, ax		; = length of data including CR
	rep movsb
	pop di
	pop si
	jmp .chain

.error:		; ZR if == 5, NZ if == 4
	jne .error_address	; have address -->
.error_column:
	sub si, word [relocateddata]
linkdatarelocation promptlen
	jmp @F

.error_address:
	inc bx
	sub si, strict word relocateddata + 3
linkdatarelocation line_in
@@:
	cmp si, 256
	jb @F
	xor si, si
@@:
	mov word [source], si
internaldatarelocation
	xor ax, ax
	mov al, [word array + si]
internaldatarelocation
	xchg si, ax		; si = column without promptlen

	rol byte [active], 1
internaldatarelocation
	jc .debug_error

.debug_done:
	add si, word [relocateddata]
linkdatarelocation promptlen
	jmp .chain

.debug_error:
	push bx
	xor bx, bx
	mov dx, msg.empty
internaldatarelocation
	xor cx, cx
	mov cl, [relocateddata + 1]
linkdatarelocation line_in
	jcxz .empty
	push cx
.loop1:
	call .debug_marker
	mov al, [word relocateddata + 2 + bx]
linkdatarelocation line_in
	cmp al, 9
	jne .notab
.tab:
	mov ax, "\t"
	jmp @F
.notab:
	cmp al, 10
	jne .nolf
.lf:
	mov ax, "lf"
	jmp @F
.nolf:
	cmp al, 13
	jne .nocr
.cr:
	mov ax, "cr"
	jmp @F
.nocr:
	cmp al, 32
	jae @F
	mov al, '.'
@@:
	extcallcall putc
	xchg al, ah
	extcallcall putc
	inc bx
	loop .loop1
	call .debug_marker
	mov dx, msg.debugcr
internaldatarelocation
	inc bx
	call .set_debug_marker
	cmp al, '*'
	jne @F
	mov dx, msg.debugcr_marker
internaldatarelocation
@@:
	extcallcall putsz
	pop cx
	xor bx, bx
	inc cx
	inc cx
.loop2:
	call .debug_marker
	mov di, relocateddata
linkdatarelocation line_out
	mov al, [word array + bx]
internaldatarelocation
	extcallcall hexbyte
	push cx
	push bx
	extcallcall putsline
	pop bx
	pop cx
	inc bx
	loop .loop2
	mov dx, msg.linebreak
internaldatarelocation
.empty:
	extcallcall putsz

	pop bx
	jmp .debug_done


.debug_marker:
	call .set_debug_marker
	extcallcall putc
	retn

.set_debug_marker:
	mov ax, 2020h
	cmp word [source], bx
internaldatarelocation
	jne @F
	mov al, '*'
@@:
	retn


.reset:
	push si
	push ax
	push bx		; preserve bl !
	mov si, relocateddata + 2
linkdatarelocation line_in
	mov dx, [relocateddata]
linkdatarelocation promptlen
	mov di, array
internaldatarelocation
	mov bx, si
	sub bx, di	; array byte + bx = array byte - array + line_in+2
	xor ax, ax
	mov cx, 256
.reset_loop:
	mov dh, 1	; default to advance by 1 column
	cmp byte [di + bx], 9
			; tab in line_in ?
	 stosb
	jne .reset_no_tab
	mov dh, dl
	and dh, 7	; position in current tab column, 0..7
	neg dh
	add dh, 8	; 8 - position = how many byte columns to fill, 1..8
.reset_no_tab:
	add dl, dh
	add al, dh
	loop .reset_loop
	pop bx
	pop ax
	pop si
	jmp .chain


	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.keyword_help
internaldatarelocation
	call isstring?
	je help
	lodsb
	extcall iseol?
	je help
	extcall error

help:
	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 command
internalcoderelocation
at htHandler,		dw relocateddata
linkdatarelocation ext_command_handler
at htInstalled,		dw 0
	iend
hooktable_end:


	align 2, db 0
active:			db 0


msg:
.errfix:		asciz "ERRFIX"
.on:			asciz "ON"
.off:			asciz "OFF"
.toggle:		asciz "TOGGLE"
.debug:			asciz "DEBUG"
.debug_on:		asciz "ERRFIX debugging output is enabled.",13,10
.debug_off:		asciz "ERRFIX debugging output is disabled.",13,10
.empty:			asciz "[Empty line]",13,10
.debugcr:		db "CR"
.linebreak:		asciz 13,10
.debugcr_marker:	db "CR"
.linebreak_marker:	asciz "*",13,10
.uninstall_done:	db "ERRFIX uninstalled."
%if _ELD_RECLAIM_HINT
			db " (Don't forget to use reclaim.eld)"
%endif
			asciz 13,10
.uninstall_error:	asciz "ERRFIX unable to uninstall!",13,10

uinit_data: equ $

.keyword_help:	asciz "HELP"
.installed:	asciz "ERRFIX installed.",13,10
.cannotinstall:	asciz "ERRFIX cannot install, indirect array variable is in use!",13,10
.help:		db "Install this ELD using an INSTALL keyword.",13,10
		db 13,10
		db "Run with ERRFIX DEBUG to display debug output status.",13,10
		db "Run with ERRFIX DEBUG ON to enable debug output.",13,10
		db "Run with ERRFIX DEBUG OFF to disable debug output. (Disabled by default.)",13,10
		db "Run with ERFFIX DEBUG TOGGLE to toggle debug output.",13,10
		db "Run with ERRFIX 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
array:	resb 256
source:	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
	cmp word [relocateddata], byte 0
linkdatarelocation indirect_array_errfix, -3
	je @F
	mov ax, 0E6Eh
	extcall setrc
	mov dx, msg.cannotinstall
internaldatarelocation
	call putsz
	xor ax, ax
	retf

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

	 push ss
	 pop es
	xor ax, ax
	mov di, array
internaldatarelocation
	push di
	mov cx, 256
@@:
	stosb
	inc ax
	loop @B
	pop word [relocateddata]
linkdatarelocation indirect_array_errfix
	retf


%include "eldlink.asm"

	align 16
code_size equ $ - code
