
; Public Domain

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

%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 "Define alias 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 "ALIAS"
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.alias
internaldatarelocation
	extcallcall isstring?
	je .ours
	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.list
internaldatarelocation
	extcallcall isstring?
	je list
	mov dx, msg.add
internaldatarelocation
	extcallcall isstring?
	je add
	mov dx, msg.del
internaldatarelocation
	extcallcall isstring?
	je del
	mov dx, msg.size
internaldatarelocation
	extcallcall isstring?
	je size
	lodsb
	extcallcall chkeol
	extcallcall cmd3


preprocess:
.:	jmp strict short .entry
.chain:
	extcall cmd3_preprocessed, required	; must NOT be extcallcall
	times 10 - ($ - .) nop
.entry:
	push si
	cmp al, '-'
	jne @F
	extcallcall skipcomma
@@:
	dec si

	mov dx, buffer
internaldatarelocation

	push si

.loop:
	cmp dx, word [buffer.last]
internaldatarelocation
	jae .chain2
	inc dx
	pop si
	push si
	mov di, si
	push dx
	extcallcall isstring?
	pop dx
	je .ours
	dec dx
	call skip
	mov dx, si
	jmp .loop

.chain2:
	pop si
.chain1:
	pop si
	dec si
	extcallcall skipwhite
	jmp .chain

.ours:
	call geterrfix
	jz .no_errfix
	add bx, di		; alias first byte in line_in + errfix array
	sub bx, strict word relocateddata + 2
linkdatarelocation line_in	; = displacement in line_in + errfix array
				;  -> start of alias in errfix array
	mov al, byte [bx]	; get start of alias's column
.no_errfix:
	push ax			; stack = alias start column (to insert for alias)
	mov bx, dx			; dx -> alias matched
	mov di, si			; di -> separator after alias
@@:
	lodsb
	extcallcall iseol?.notsemicolon
	jne @B				; si -> after EOL
	push si				; stack -> after EOL
	xor cx, cx
	mov cl, [bx - 1]		; cx = alias length

	add bx, cx			; bx -> NUL
	inc bx				; bx -> expansion length byte
	xor ax, ax
	mov al, byte [bx]		; ax = expansion length
	sub ax, cx			; expansion length - alias length
					; = how much to insert
	jbe .no_reset
	add byte [relocateddata + 1], al
linkdatarelocation line_in

	extcallcall yy_reset_buf
	mov cx, si			; -> after EOL
	sub cx, di			; = trail length
	mov di, si			; -> after EOL
	add di, ax			; -> after destination for EOL
	cmp di, strict word relocateddata
linkdatarelocation line_in.end
	jbe @F
	mov ax, 0E10h
	extcallcall setrc
	mov dx, msg.lineinoverflow
internaldatarelocation
	extcallcall putsz
	extcallcall cmd3

@@:
	push cx
	call moveup
	pop cx
	pop si				; -> after EOL
	push bx
	call geterrfix
	jz @F
	add si, bx			; -> after EOL + errfix array
	sub si, strict word relocateddata + 2 - 1
linkdatarelocation line_in		; -> after byte after EOL in errfix array
	mov di, ax			; = how much to insert
	add di, si			; -> after EOL destination in array
	inc cx				; count byte after EOL
	call moveup
@@:
	pop bx
.common:
	pop ax				; al = errfix byte to write
	pop di				; -> alias matched in line_in
	lea si, [bx + 1]		; -> expansion
	mov cl, byte [bx]		; cx = length of expansion
	push di
	push cx
	rep movsb			; write expansion
	pop cx
	pop di
	call geterrfix
	jz @F
	add di, bx
	sub di, strict word relocateddata + 2
linkdatarelocation line_in		; -> at destination in errfix array
	rep stosb
@@:
	jmp .chain1			; chain back

.no_reset:	; ax = how much to insert, negative or zero
		;  = minus how much to delete
	add byte [relocateddata + 1], al
linkdatarelocation line_in
	mov cx, si			; -> after EOL
	mov si, di			; -> separator
	sub cx, di			; = trail length
	add di, ax			; -> trail destination
	push cx
	rep movsb
	pop cx
	pop si				; -> after EOL of source
	push bx
	call geterrfix
	jz @F
	sub si, cx			; -> at source in line_in
	add si, bx
	sub si, strict word relocateddata + 2
linkdatarelocation line_in		; -> at source in errfix array
	mov di, si
	add di, ax			; -> at destination in errfix array
	rep movsb			; move down trail of array
@@:
	pop bx
	jmp .common


		; OUT:	ZR if no errfix.eld installed
		;	NZ if it is installed,
		;	 bx -> errfix array
		; CHG:	bx
geterrfix:
	mov bx, relocateddata
linkdatarelocation indirect_array_errfix, -2, optional
	test bx, bx		; not supported ?
	jz @F
	mov bx, [bx]		; -> errfix.eld array, or 0
@@:
	test bx, bx
	retn


moveup:
	std
	cmpsb				; -> last bytes
	jcxz @FF
	cmp cx, 20
	ja @FF
@@:
	movsb
	loop @B
@@:
	rep movsb			; move up
	cld
	retn


getalias:
	extcallcall skipcomma
.skipped:
	dec si
	mov bx, si			; bx -> start of alias
@@:
	lodsb
	cmp al, 32
	je @F
	cmp al, 9
	je @F
	cmp al, ','
	je @F
	extcallcall iseol?.notsemicolon
	jne @B
%if 0
	mov dx, msg.unexpected_eol
internaldatarelocation
	extcallcall putsz
	extcallcall cmd3
%endif

@@:
	lea cx, [si - 1]		; cx -> behind alias
	sub cx, bx			; cx = alias length
	jnz @F
	mov ax, 0E11h
	extcallcall setrc
	mov dx, msg.empty_alias
internaldatarelocation
	extcallcall putsz
	extcallcall cmd3

@@:
	extcallcall skipcomm0
	dec si
	retn


del:
	call getalias
	lodsb
	extcallcall chkeol

	call finddel
	jnc .do
	mov ax, 0E12h
	extcallcall setrc
	mov dx, msg.delnotfound
internaldatarelocation
	extcallcall putsz
@@:
	extcallcall cmd3

.do:
	call dodel
	jmp @B


		; INP:	bx -> alias (need not be allcaps)
		;	cx = length of alias (< 256)
		; OUT:	CY if not found
		;	NC if found,
		;	 dx -> alias found
		; CHG:	si, di, ax, dx
finddel:
	mov si, buffer
internaldatarelocation

.loop:
	cmp si, word [buffer.last]
internaldatarelocation
	jae .notfound
	mov dx, si
	lodsb
	cmp al, cl
	jne .next
	mov di, bx
	xchg si, di
	push cx
@@:
	lodsb
	extcallcall uppercase
	scasb
	loope @B
	pop cx
	; jne .next
	je .found		; (if ZR then also NC)
.next:
	call skip
	jmp .loop

.notfound:
	stc
.found:
	retn


		; INP:	dx -> entry in buffer
		; OUT:	buffer content moved down, word [buffer.last] updated
		; CHG:	si, di, cx, ax
dodel:
	mov di, dx
	call skip
	mov cx, word [buffer.last]
internaldatarelocation
	sub cx, si
	rep movsb
	mov word [buffer.last], di
internaldatarelocation
	retn


		; INP:	dx -> entry in buffer
		; OUT:	si -> behind this entry
		; CHG:	ax
skip:
	mov si, dx
	xor ax, ax
	lodsb
	add si, ax
	inc si
	lodsb
	add si, ax
	retn


add:
	call getalias

	push si
	and word [replacelength], strict byte 0
internaldatarelocation -3
	call finddel
	jc @F
	call skip
	sub si, dx
	mov word [replacelength], si
internaldatarelocation
@@:
	pop si

	mov dx, si			; dx -> expansion
@@:
	lodsb
	extcallcall iseol?.notsemicolon
	jne @B

	mov di, si			; -> after CR
@@:
	dec di				; first iteration: -> CR
	cmp dx, di
	jae @F
	cmp byte [di - 1], 32		; trailing blank ?
	je @B
	cmp byte [di - 1], 9
	je @B				; yes, decrement -->
@@:
	sub di, dx			; di = expansion length
	mov ax, cx			; = alias length
	add ax, 3			; account for count, NUL, count
	add ax, di			; + expansion length, result is < 260
	mov si, word [buffer.last]
internaldatarelocation
	sub si, word [replacelength]
internaldatarelocation
	add ax, si			; -> after end of space needed
	jc .toofull			; if carry -->
	cmp ax, word [buffer_end_indirect]
internaldatarelocation
	; ja .toofull			; if doesn't fit -->
	jbe @F
.toofull:
	mov ax, 0E13h
	extcallcall setrc
	mov dx, msg.toofull
internaldatarelocation
	extcallcall putsz
	extcallcall cmd3

@@:
	push dx
	push di
	call finddel
	jc @F
	push cx
	call dodel
	pop cx
@@:
	pop di
	pop dx

	mov si, word [buffer.last]
internaldatarelocation
	xchg di, si			; di -> after last alias, si = expansion length
	mov ax, cx			; ax = alias length
	stosb				; store length
	xchg si, bx			; si -> alias, bx = expansion length
@@:
	lodsb
	extcallcall uppercase
	stosb
	loop @B				; store alias
	mov al, 0
	stosb				; store a NUL
	mov al, bl			; ax = expansion length
	stosb				; store expansion length
	mov si, dx			; -> expansion
	xchg cx, ax			; cx = expansion length
	rep movsb			; store expansion
	mov word [buffer.last], di
internaldatarelocation			; -> behind new alias
	extcallcall cmd3


size:
	extcallcall skipcomma
	extcallcall chkeol
	mov di, relocateddata
linkdatarelocation line_out
	mov si, msg.size.1
internaldatarelocation
	extcallcall copy_single_counted_string
	mov ax, word [buffer_end_indirect]
internaldatarelocation
	sub ax, strict word buffer
internaldatarelocation
	extcallcall decword
	extcallcall putsline_crlf
	extcallcall cmd3


list:
	extcallcall skipcomma
	extcallcall iseol?.notsemicolon
	je .all

	call getalias.skipped
	lodsb
	extcallcall chkeol

	call finddel
	jnc .found
	mov ax, 0E14h
	extcallcall setrc
	mov dx, msg.listnotfound
internaldatarelocation
	extcallcall putsz
	extcallcall cmd3

.found:
	mov si, dx
	call .single
	extcallcall cmd3

.all:
	mov si, buffer
internaldatarelocation

	cmp si, word [buffer.last]
internaldatarelocation
	jb @F
	mov ax, 0E15h
	extcallcall setrc
	mov dx, msg.no_aliases
internaldatarelocation
	extcallcall putsz
	extcallcall cmd3

@@:

.loop:
	cmp si, word [buffer.last]
internaldatarelocation
	jb @F
	extcallcall cmd3

@@:
	call .single
	jmp .loop

.single:
	lodsb
	mov dx, si
	xor cx, cx
	mov cl, al
	add si, cx
	mov di, cx
	extcallcall puts
	cmp byte [si + 1], 0
	je .next_si_plus_2
	mov al, 32
	neg di
	lea cx, [di + 10]
	cmp cx, 2
	jbe .2
	cmp cx, 10
	jbe @F
.2:
	mov cx, 2
@@:
	extcallcall putc
	loop @B
	inc si
	lodsb
	mov cl, al
	mov dx, si
	add si, cx
	extcallcall puts
	db __TEST_IMM8		; skip lodsw
.next_si_plus_2:
	lodsw
	mov al, 13
	extcallcall putc
	mov al, 10
	extcallcall putc
	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


	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


get_es_ext:
	mov es, word [relocateddata]
linkdatarelocation extdssel
	extcallcall ispm
	jz @F
	mov es, word [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
	endstruc

	align 2, db 0
hooktable:
		; command last so uninstall abort will leave command installed
	istruc HOOKTABLE
at htEntry,		dw preprocess
internalcoderelocation
at htHandler,		dw relocateddata
linkdatarelocation ext_preprocess_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:

buffer.last:		dw buffer
internaldatarelocation
buffer_end_indirect:	dw 0

msg:
.alias:			asciz "ALIAS"
.size:			asciz "SIZE"
.list:			asciz "LIST"
.add:			asciz "ADD"
.del:			asciz "DEL"
.size.1:		counted "Alias buffer size is "
.empty_alias:		asciz "Error: No alias name specified!",13,10
.toofull:		asciz "Error: Alias buffer is too full!",13,10
.no_aliases:		asciz "No aliases defined currently.",13,10
.listnotfound:
.delnotfound:		asciz "No such alias defined.",13,10
.lineinoverflow:	asciz "Alias error: Overflowed line_in!",13,10
.uninstall_done:	db "ALIAS uninstalled."
%if _ELD_RECLAIM_HINT
			db " (Don't forget to use reclaim.eld)"
%endif
			asciz 13,10
.uninstall_error:	asciz "ALIAS unable to uninstall!",13,10

uinit_data: equ $

.installed:	asciz "ALIAS installed.",13,10
.installerror:	asciz "ALIAS unable to install, out of data memory.",13,10
.help:		db "Install this ELD using an INSTALL keyword.",13,10
		db 13,10
		db "To add, run as ALIAS ADD <aliasname> <expansion>",13,10
		db "To delete, run as ALIAS DEL <aliasname>",13,10
		db "To list, run as ALIAS LIST [<aliasname>]",13,10
		db 13,10
		db "Run with ALIAS 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
replacelength:	resw 1
	alignb 16
buffer:
.defaultsize equ 1024

	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:
	mov dx, buffer.defaultsize
	extcall skipcomma
	extcall iseol?
	je .default
	extcall getword
	extcall chkeol
.default:

	houdini
	mov es, bx		; => ext seg (writable)

	mov ax, buffer + 15
internaldatarelocation
	and al, ~15
	add ax, dx
	jc .error

	mov bx, ax
	sub bx, word [relocateddata]
linkdatarelocation extdata
	cmp bx, word [relocateddata]
linkdatarelocation extdata_size
	ja .error
	mov word [buffer_end_indirect], ax
internaldatarelocation
	mov word [es:code + eldiEndData], ax
internalcoderelocation		; adjust size
	mov word [relocateddata], bx
linkdatarelocation extdata_used	; adjust size

	mov ax, endresident - endinstalled
	sub word [es:code + eldiEndCode], ax
internalcoderelocation		; adjust size
	sub word [relocateddata], ax
linkdatarelocation extseg_used	; adjust size

	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

.error:
	mov dx, msg.installerror
internaldatarelocation
	call putsz
	mov ax, 0FFFCh
	retf


%include "eldlink.asm"

	align 16
code_size equ $ - code
