
; Public Domain

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

%include "lmacros3.mac"

	numdef OTHER, 0
%if _OTHER
 %define ELDOTHER 1
 %define OTH_STRING "OTH"
 %define NAME_STRING "INSTNOTH"
 %idefine ownss ss:
 %imacro getotherds 0
	mov ds, word [ss:otherds]
internaldatarelocation
 %endmacro
 %imacro resetds 0
	push ss
	pop ds
 %endmacro
 %imacro getotheres 0
	mov es, word [ss:otherds]
internaldatarelocation
 %endmacro
 %imacro resetes 0
	push ss
	pop es
 %endmacro
%else
 %define OTH_STRING ""
 %define NAME_STRING "INSTNOUN"
 %idefine ownss
 %idefine getotherds
 %idefine resetds
 %idefine getotheres
 %idefine resetes
%endif

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

description:		asciz "List INSTALL command nouns."


	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 "INSTNOUN"
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.instnoun
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

%if _OTHER
	mov ax, word [otherseg]
internaldatarelocation
	extcallcall ispm
	jnz @F
	xchg dx, ax
	extcallcall setes2dx
	mov ax, word [es:relocateddata]
otherlinkdatarelocation dssel
@@:
	mov word [otherds], ax
internaldatarelocation
%endif

	call run
	extcallcall cmd3

uninstall:
	lodsb
	extcallcall chkeol

	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


run:
	push ss
	pop es

	mov ax, relocateddata
otherlinkdatarelocation installformat, -2, optional
	test ax, ax
	jnz @F
	mov ax, 0E41h
	extcallcall setrc
	mov dx, msg.none
internaldatarelocation
.putsz_end:
	extcallcall putsz
	retn

@@:
	cmp ax, 1
	je @F
	mov ax, 0E42h
	extcallcall setrc
	mov dx, msg.unknown
internaldatarelocation
	jmp .putsz_end

@@:
	extcallcall skipcomma
	extcallcall iseol?
	je list

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

	mov cx, set
internalcoderelocation
	mov dx, msg.install
internaldatarelocation
	extcallcall isstring?
	je change_or_toggle
	mov dx, msg.set
internaldatarelocation
	extcallcall isstring?
	je change

	mov cx, clear
internalcoderelocation
	mov dx, msg.uninstall
internaldatarelocation
	extcallcall isstring?
	je change
	mov dx, msg.clear
internaldatarelocation
	extcallcall isstring?
	je change

	mov cx, toggle
internalcoderelocation
	mov dx, msg.toggle
internaldatarelocation
	extcallcall isstring?
	je change

	extcallcall error

change_or_toggle:
	extcallcall skipcomma
	dec si
	mov dx, msg.toggle
internaldatarelocation
	extcallcall isstring?
	jne @F
	mov cx, toggle
internalcoderelocation
@@:
change:
	mov byte [quiet], bl
internaldatarelocation
	extcallcall skipcomma
	push si
.loopcheck:
	dec si
	call checkinstallflag	; valid command ? (errors out if no)
	getotherds
	mov di, word [bx + ifOptions]
	test di, di		; normal with options pointer ?
	jz error		; no -->
	resetds
	extcallcall skipcomma
	extcallcall iseol?
	jne .loopcheck

	pop si
.loopdo:
	dec si
	call checkinstallflag	; re-detect which it is, cannot fail
	getotherds
	mov dx, word [bx + ifDescription]
	mov di, word [bx + ifOptions]
	mov ax, word [bx + ifValue]
	test di, di		; normal with options pointer ?
	jz error		; no -->
	call cx			; call install.set or install.clear
	resetds
	extcallcall skipcomma
	extcallcall iseol?
	jne .loopdo
	retn


		; OUT:	ZR if not reverse
isreverse:
		; (n & (n - 1)) != 0
	push bx
	mov bx, ax
	dec bx
	and bx, ax
	pop bx
	retn


toggle:
	call isreverse
	jz .togglenormal

.togglereverse:
	not ax
	xor word [di], ax
	test word [di], ax
	jz settry
	jmp @F

.togglenormal:
	xor word [di], ax
	test word [di], ax
	jnz settry
@@:
	jmp cleartry


set:
	call isreverse
	jz .setnormal

.setreverse:
	not ax
	test word [di], ax	; already clear ?
	jz @F			; yes -->
	not ax
	and word [di], ax	; clear flag
	jmp settry


.setnormal:
	test word [di], ax	; already set ?
	jnz @F			; yes -->
	or word [di], ax	; set flag
settry:
	rol byte [ownss quiet], 1
internaldatarelocation
	jc reset
	call putsz
	mov dx, msg.tryenable
internaldatarelocation
	jmp .putsz

@@:
	rol byte [ownss quiet], 1
internaldatarelocation
	jc reset
	call putsz
	mov dx, msg.alreadyenabled
internaldatarelocation
.putsz:
	resetds
	jmp putsz


clear:
	call isreverse
	jz .clearnormal

.clearreverse:
	not ax
	test word [di], ax	; already set ?
	jnz @F
	or word [di], ax	; set flag
	jmp cleartry

.clearnormal:
	test word [di], ax	; already clear ?
	jz @F			; yes -->
	not ax			; get mask value
	and word [di], ax	; clear flag
cleartry:
	rol byte [ownss quiet], 1
internaldatarelocation
	jc reset
	call putsz
	mov dx, msg.trydisable
internaldatarelocation
.putsz:
	jmp settry.putsz

@@:
	rol byte [ownss quiet], 1
internaldatarelocation
	jc reset
	call putsz
	mov dx, msg.alreadydisabled
internaldatarelocation
	jmp .putsz


reset:
	resetds
	retn


checkinstallflag:
	getotheres
	mov bx, relocateddata - INSTALLFLAG_size
otherlinkdatarelocation installflags
@@:
	add bx, INSTALLFLAG_size
%if _OTHER
	es
%endif
	mov dx, word [bx + ifKeyword]
	test dx, dx
	jz .error
	call isstring?
	jne @B
	resetes
	retn

.error:
	jmp error


list:
	xor ax, ax
	lframe none
	lenter
	lvar word, last
	 push ax

	mov si, relocateddata
otherlinkdatarelocation installflags
loop:
	houdini
	mov di, relocateddata
linkdatarelocation line_out

	getotherds
	lodsw				; ifKeyword
	test ax, ax
	jz end

	push ax

	lodsw				; ifDescription
	cmp ax, word [bp + ?last]
	jne @F

	mov al, 32
	mov cx, 12
	rep stosb
	pop ax
	call copy_asciz

	jmp next

@@:
	lodsw				; ifOptions
	extcallcall hexword
	xchg bx, ax

	mov al, 32
	stosb

	lodsw				; ifValue
	extcallcall hexword
	xchg dx, ax

	mov al, 32
	stosb

	mov ax, "? "
	test bx, bx
	jz @F

	mov al, '+'

		; (n & (n - 1)) != 0
	push bx
	mov bx, dx
	dec bx
	and bx, dx
	pop bx
	jz .notreverse

	not dx
	mov al, '-'

.notreverse:
	test word [bx], dx
	jnz @F
	xor al, '+' ^ '-'
@@:
	stosw

	pop ax

	call copy_asciz

	mov al, 32
	mov cx, relocateddata + 15 + 10 + 2
linkdatarelocation line_out
	sub cx, di
	jbe @F
	rep stosb
@@:
	stosb

	sub si, 6			; ifTrying - ifDescription
	lodsw				; ifDescription
	mov word [bp + ?last], ax
	call copy_asciz

next:
	add si, 8			; INSTALLFLAG_size - (ifDescription + 2)

	resetds
	extcallcall putsline_crlf
	jmp loop

end:
	resetds
	lleave , forcerestoresp
	retn


copy_asciz:
	push si
	xchg si, ax
	db __TEST_IMM8
@@:
	stosb
	lodsb
	test al, al
	jnz @B
	pop si
	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, relocateddata
linkdatarelocation msg.run
	call isstring?
	call run
	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


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


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

%if _OTHER
	align 2, db 0
otherds:	dw 0
otherseg:	dw 0
%endif

msg:
.instnoun:		asciz NAME_STRING
.uninstall:		db "UN"
.install:		asciz "INSTALL"
.toggle:		asciz "TOGGLE"
.set:			asciz "SET"
.clear:			asciz "CLEAR"
.quiet:			asciz "QUIET"
.alreadyenabled:	asciz " is already enabled.",13,10
.alreadydisabled:	asciz " is already disabled.",13,10
.tryenable:		asciz ": Trying to enable.",13,10
.trydisable:		asciz ": Trying to disable.",13,10
.uninstall_done:	db NAME_STRING," command uninstalled."
%if _ELD_RECLAIM_HINT
			db " (Don't forget to use reclaim.eld)"
%endif
			asciz 13,10
.uninstall_error:	asciz NAME_STRING," command unable to uninstall!",13,10
.installed:		asciz NAME_STRING," command installed.",13,10

.none:			asciz "No install flag format link found.",13,10
.unknown:		asciz "Unknown install flag format.",13,10


uinit_data:

	align 16, db 0
data_size equ $ - datastart

	absolute uinit_data

quiet:			resb 1

	alignb 16
uinit_data_end:

total_data_size equ $ - datastart
%assign _DATA_SIZE total_data_size

	usesection CODE

%include "eldlink.asm"

	align 16
code_size equ $ - code
