
; Public Domain

; test install command: install; s $ psp:0 l 10 CD; s uninstall
; test run command: $ psp:0 l 10 CD; .; .

%include "lmacros3.mac"
%include "eld.mac"
%include "eldcall.mac"
%include "elddata.mac"

%assign _CATCHINT0C 0
%assign _CATCHINT0D 0
%assign _CATCHINTFAULTCOND 0
%assign _LOADER 0
%assign _DEBUG 0
%assign _DELAY_BEFORE_BP 0
%assign _DHIGHLIGHT 0
%assign _GETLINEHIGHLIGHT 0
%assign _IMMASM 0
%assign _INPUT_FILE_BOOT 0
%assign _INPUT_FILE_HANDLES 0
%assign _MS_0RANGE_COMPAT 0
%assign _PM 0
%assign _RH 0
%assign _SYMBOLIC 0
%assign _VXCHG 0
%include "options.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
PUT_ELDHX_DATETIME_OFFSET
header_extension_end:
	iend

description:		asciz "Provide S (search memory) command."


	align 16, db 0

	eldstrict on

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 "S cmd"
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

%if 0
	lodsb
	extcallcall uppercase
	cmp al, 'S'
	je @F
.transfer_to_chain:
	pop si
	dec si
	lodsb
	jmp .chain

@@:
	dec si			; -> at 'S'
reloc	mov dx, msg.sleep
internaldatarelocation
	extcallcall isstring?	; check for "SLEEP"
	je .transfer_to_chain
	inc si			; skip 'S'
%else
		; better detection: require S to match as
		;  a string, so cannot mean any ELDs.
		;  implies that it is not handled if the user
		;  enters S with the address immediately behind
		;  the S without a blank or comma.
reloc	mov dx, msg.s
internaldatarelocation
	extcallcall isstring?
	je .ours
.transfer_to_chain:
	pop si
	dec si
	lodsb
	jmp .chain
%endif

.ours:
	pop ax
	extcallcall skipcomma
	dec si
reloc2	mov word [relocateddata], relocateddata
linkdatarelocation lastcmd, -4
linkdatarelocation dmycmd
reloc	mov dx, relocateddata
linkdatarelocation msg.uninstall
	extcallcall isstring?
	je uninstall
	lodsb
	call sss
	extcallcall cmd3

uninstall:
	lodsb
	extcallcall chkeol

reloc	mov es, word [relocateddata]
linkdatarelocation extdssel
	extcallcall ispm
	jz @F
reloc	mov es, word [relocateddata]
linkdatarelocation extseg
@@:
	push es
	pop ds
	xor bx, bx		; = 0 (no prior, modify ext_command_handler)
reloc	mov di, command		; di -> us
internalcoderelocation
reloc	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:
reloc	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:
reloc	clropt [code + eldiFlags], eldifResident
internalcoderelocation -3	; mark block as free
reloc	mov dx, msg.uninstall_done
internaldatarelocation
@@:
	push ss
	pop ds
	extcallcall putsz
	extcallcall cmd3	; return

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


%define relocated(address) relocateddata
%assign ELD 1
%assign _PM 1
%assign _LOADER 0
%assign _ONLY386 0
%assign _ONLYNON386 0
%assign _SWHILEBUFFER 0
%assign _SCOUNT 1
%assign _SDUMP 1
%assign _SDUMPDISPLACEMENT 1
%assign _SREVERSE 1
%assign _AUXBUFFSIZE 8192 + 16
%define lDEBUG_CODE CODE
%define lDEBUG_DATA_ENTRY DATA
%define dualcall call
	cpu 8086
%assign _WPT_LABELS 0

%include "386.mac"

%include "ssshared.asm"


%assign _STRNUM 1

%if _STRNUM
getstr_check_limit:
reloc	cmp di, word [word getstr_dispatch_table.limit + bx]
internaldatarelocation
	jbe getstr_retn
%endif
errorj2a:
	jmp error

;	GETSTR - Get string of bytes.  Put the answer in line_out.
;		Entry	AL	first character
;			SI	address of next character
;		Exit	[line_out] first byte of string
;			DI	address of last+1 byte of string
;		Uses	AX, cx, dx,SI
getstr_sss:
	dec si
	lframe
	lenter
	mov cx, words(tagbuffer.size)
	xor ax, ax
reloc	mov di, tagbuffer
internaldatarelocation
	 push di		; -> tag buffer
	lvar word, idxtagbuffer
	 push ax		; = 0
	lvar word, tag
	lequ 1, tagwild
	lequ 2, tagcaps
	rep stosw		; cx = 0

%if _STRNUM
	push bx
	xor bx, bx		; 0 = byte size as default
%endif
	extcallcall skipcomma
reloc	mov di, relocateddata
linkdatarelocation line_out
	extcallcall iseol?
	je short errorj2a	; we don't allow empty byte strings

getstr_loop:
	extcallcall skipcomm0
%if _STRNUM
	dec si			; -> nonblank
reloc	mov dx, msg.as		; "AS" keyword ?
internaldatarelocation
	extcallcall isstring?
	jne .notas		; no -->
	extcallcall skipcomma
	dec si			; -> nonblank
	push cx
	extcallcall get_length_keyword
	jnz errorj2a
	cmp cl, 2		; 0 = bytes, 1 = words, 2 = dwords
				; (ch is always zero)
	ja errorj2a		; higher is invalid -->
	mov bx, cx
	add bx, bx		; make a table offset
	pop cx
	lodsb
	jmp getstr_next

.notas:
%endif
reloc	mov dx, msg.wild
internaldatarelocation
	extcallcall isstring?
	jne .notwild
	setopt [bp + ?tag], ?tagwild
%if _STRNUM
	call getstr_check_limit
reloc	call near [word getstr_dispatch_table.string + bx]
internaldatarelocation
%else
	inc di
	call storetag
%endif
	clropt [bp + ?tag], ?tagwild
.lod:
	lodsb
	jmp getstr_next

.notwild:
reloc	mov dx, msg.caps
internaldatarelocation
	extcallcall isstring?
	jne .notcaps
	setopt [bp + ?tag], ?tagcaps
	jmp .lod

.notcaps:
reloc	mov dx, msg.uncaps
internaldatarelocation
	extcallcall isstring?
	jne .notuncaps
	clropt [bp + ?tag], ?tagcaps
	jmp .lod

.notuncaps:
	lodsb
	cmp al, "'"
	je getstr_start_quote	; if string
	cmp al, '"'
	je getstr_start_quote	; ditto

%if _STRNUM
	call getstr_check_limit
reloc	call near [word getstr_dispatch_table.numeric + bx]
internaldatarelocation
%else
	extcallcall getbyte	; byte in DL
	mov byte [di], dl	; store the byte
	inc di
%endif
	jmp short getstr_next

getstr_start_quote:
	mov ah, al		; save quote character
getstr_loop_quoted:
	lodsb
	cmp al, ah
	je getstr_quote_quoted	; if possible end of string
	extcallcall iseol?.notsemicolon
	je errorj2a		; if end of line
getstr_store_quoted:
%if _STRNUM
	call getstr_check_limit
reloc	call near [word getstr_dispatch_table.string + bx]
internaldatarelocation
%else
	stosb			; save character and continue
%endif
	jmp short getstr_loop_quoted

getstr_quote_quoted:
	lodsb
	cmp al, ah
	je getstr_store_quoted	; if doubled quote character
getstr_next:
	extcallcall skipcomm0	; go back for more
	extcallcall iseol?
	je .ret
	dec si
reloc	mov dx, msg.end
internaldatarelocation
	extcallcall isstring?
	lodsb
	jne getstr_loop			; if not done yet
.ret:
%if _STRNUM
	pop bx
%endif
	lleave code
%if _STRNUM
getstr_retn:
%endif
	retn


%if _STRNUM
getstr_numeric_byte:
	extcallcall getbyte	; byte in DL
	mov byte [di], dl	; store the byte
	inc di
	jmp storetag

getstr_numeric_word:
	extcallcall getword	; dx
	mov word [di], dx	; store
	scasw			; di += 2
storetagtwice:
	call storetag
	jmp storetag

getstr_numeric_dword:
	push bx
	extcallcall getdword	; bx:dx
	mov word [di], dx	; store
	scasw			; di += 2
	mov word [di], bx	; store
	scasw			; di += 2
	pop bx
	call storetagtwice
	jmp storetagtwice


getstr_string_word:
	stosb			; save character and continue
	call storetag
	mov al, 0
	jmp getstr_string_byte

getstr_string_dword:
	stosb			; save character and continue
	call storetagtwice
	call storetag
	mov al, 0
	stosb
	stosb
getstr_string_byte:
	stosb
	; fall through

storetag:
	push ax
	xchg di, word [bp + ?idxtagbuffer]
reloc	cmp di, strict word tagbuffer.end
internaldatarelocation
	jae error
	mov al, byte [bp + ?tag]
	shl al, cl
	or byte [di], al
	inc cx
	inc cx
	cmp cl, 8
	jb @F
	mov cl, 0
	inc di
@@:
	xchg di, word [bp + ?idxtagbuffer]
	pop ax
	retn


	lleave ctx


	usesection DATA

		; REM:	Dispatch table in section CODE (ELD code segment)
	align 2, db 0
getstr_dispatch_table:
.numeric:
reloc		dw getstr_numeric_byte
internalcoderelocation
reloc		dw getstr_numeric_word
internalcoderelocation
reloc		dw getstr_numeric_dword
internalcoderelocation
.string:
reloc		dw getstr_string_byte
internalcoderelocation
reloc		dw getstr_string_word
internalcoderelocation
reloc		dw getstr_string_dword
internalcoderelocation
.limit:
reloc		dw relocateddata - 1
linkdatarelocation line_out_end
reloc		dw relocateddata - 2
linkdatarelocation line_out_end
reloc		dw relocateddata - 4
linkdatarelocation line_out_end

	usesection CODE
%endif	; _STRNUM


error:
	extcall error

	eldcall_dump_callcall ELDCALL_CALLCALL_LIST

endinstalled equ ($ + CODEFIXUP + 15) & ~15

	align 2, db 0				; align on word boundary
		; Table of patches that are to be set NOP if not running on a 386.
writepatchtable patch_no386_table, PATCH_NO386_TABLE
%undef PATCH_NO386_TABLE

	align 2, db 0
		; Table of patches that are to be set NOP if running on a 386.
writepatchtable patch_386_table, PATCH_386_TABLE
%undef PATCH_386_TABLE


start:
	houdini
	push si
reloc	mov dx, code
internalcoderelocation
reloc	testopt [relocateddata], has386
linkdatarelocation internalflags, -3
	jz @F
reloc	mov si, patch_386_table		; table of patches to set for 386+
internalcoderelocation
%if __patch_386_table_method == 1
	mov cx, patch_386_table_size_w
	call .patch1
%else
	call .patch2
%endif
	jmp .patch_code1_end

@@:
reloc	mov si, patch_no386_table	; table of patches to set for 16-bit CPU
internalcoderelocation
%if __patch_no386_table_method == 1
	mov cx, patch_no386_table_size_w
	call .patch1
%else
	call .patch2
%endif
	jmp .patch_code1_end

		; Complicated table patch code.
%if __patch_no386_table_method == 2 || __patch_386_table_method == 2
.patch2:
reloc	mov di, code_start		; initialise offset
internalcoderelocation
	xor ax, ax			; initialise ah
.looppatch2:
	cs lodsb
	add di, ax			; skip number of bytes to skip
	cmp al, 255			; really repositioning?
	jne .l2patch			; no -->
	xchg ax, di			; (to preserve ah)
	cs lodsw			; ax = new address
	add ax, dx
	xchg ax, di			; di = new address
.l2patch:
	cs lodsb
	mov cx, ax			; cx = number of bytes to patch
	jcxz .patchesdone		; end of table -->
	mov al, 90h			; patch to NOP
	rep stosb			; patch as many bytes as specified
	jmp short .looppatch2
%endif

		; Simple table patch code.
%if __patch_no386_table_method == 1 || __patch_386_table_method == 1
.patch1:
	jcxz .patchesdone
.looppatch1:
	cs lodsw			; load address of patch
	add ax, dx
	xchg bx, ax			; (set bx = ax, CHG ax)
	mov byte [es:bx], 90h		; patch
	loop .looppatch1
%endif
.patchesdone:
	retn

.patch_code1_end:
	pop si

	mov bx, es
	 push ss
	 pop es

	call skipcomma
	dec si
reloc	mov dx, relocateddata
linkdatarelocation msg.install
	call isstring?
	je install
	lodsb
	call sss
@@:
	call uninstall_oneshot
	xor ax, ax
	retf


uninstall_oneshot:
reloc	testopt [ss:relocateddata], 1
linkdatarelocation options7, -3
	jnz @F

reloc	mov ax, word [cs:code + eldiEndCode]
internalcoderelocation
reloc	sub ax, word [cs:code + eldiStartCode]
internalcoderelocation
reloc	sub word [relocateddata], ax
linkdatarelocation extseg_used

reloc	mov ax, word [cs:code + eldiEndData]
internalcoderelocation
reloc	sub ax, word [cs:code + eldiStartData]
internalcoderelocation
reloc	sub word [relocateddata], ax
linkdatarelocation extdata_used
@@:
	retn


install:
	lodsb
	extcall chkeol

	houdini
	mov es, bx		; => ext seg (writable)
	mov ax, endresident - endinstalled
reloc	sub word [es:code + eldiEndCode], ax
internalcoderelocation		; adjust size
reloc	sub word [relocateddata], ax
linkdatarelocation extseg_used	; adjust size
reloc	mov bx, word [relocateddata]
linkdatarelocation ext_command_handler
				; -> prior
reloc	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:
reloc	setopt [es:code + eldiFlags], eldifResident
internalcoderelocation -3	; mark block as resident
reloc2	mov word [relocateddata], command
linkdatarelocation ext_command_handler, -4
internalcoderelocation		; -> our entrypoint

reloc	testopt [relocateddata], 4
linkdatarelocation options7, -3
	jnz @F
reloc	mov dx, msg.installed
internaldatarelocation
	call putsz
@@:
	xor ax, ax
	retf


	usesection DATA
msg:
%if 0
.sleep:			asciz "SLEEP"
%else
.s:			asciz "S"
%endif
.as:			asciz "AS"
.end:			asciz "END"
.wild:			asciz "WILD"
.uncaps:		db "UN"
.caps:			asciz "CAPS"
.silent:		asciz "SILENT"
.range:			asciz "RANGE"
.reverse:		asciz "REVERSE"
.matches:		asciz " matches",13,10
.uninstall_done:	db "S command uninstalled."
%if _ELD_RECLAIM_HINT
			db " (Don't forget to use reclaim.eld)"
%endif
			asciz 13,10
.uninstall_error:	asciz "S command unable to uninstall!",13,10

uinit_data: equ $

.installed:	asciz "S command installed.",13,10

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

	absolute uinit_data

	alignb 2
tagbuffer:
.:	resb 300 / 4
.end:
.size equ .end - .
	alignb 2		; may overflow if odd tagbuffer.size

patternbuffer:
.:	resb 264
.size equ $ - .

	alignb 2
sss_repne_scasb:
	resw 1
sss_scasb:
	resw 1
sss_repe_cmpsb:
	resw 1
sss_repe_cmpsb_for_range:
	resw 1

sss_range_used:
	resb 1

%if 0 ;n _RN_AUX
	alignb 4
rn_rm_buffer:
		resb 128
%endif

	alignb 16
uinit_data_end:
resident_data_end:

%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

%include "eldlink.asm"

	align 16
code_size equ $ - code
