
; Public Domain

; test install command: install; s cs:0 l 10000 "%prompt%"; variables uninstall
; test run command: display ext printf.eld "%%s\r\n" start "%comspec%" end; .; .
; test run command:     run ext printf.eld "%%s\r\n" start "%comspec%" end; .; .

%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 "Expand environment variables in commands."


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

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

	mov dx, msg.variable
internaldatarelocation
	extcallcall isstring?
	je .shortname
	mov dx, msg.variables
internaldatarelocation
	extcallcall isstring?
	jne @F
.shortname:
	extcallcall skipcomma
	dec si
	mov dx, relocateddata
linkdatarelocation msg.uninstall
	extcallcall isstring?
	je uninstall
	mov bl, 0FFh
	mov dx, msg.on
internaldatarelocation
	extcallcall isstring?
	je set
	mov bl, 0
	mov dx, msg.off
internaldatarelocation
	extcallcall isstring?
	je set
	mov dx, msg.run
internaldatarelocation
	extcallcall isstring?
	je run_resident

@@:
	pop si
	dec si
	rol byte [status], 1
internaldatarelocation
	jc @F
	lodsb
	jmp .chain

@@:
	mov cx, relocateddata - 1
linkdatarelocation line_in.end
	xor dx, dx
	call replace
	mov cx, di
	sub cx, relocateddata + 2 + 1
linkdatarelocation line_in
	mov byte [relocateddata + 1], cl
linkdatarelocation line_in
	jmp .chain


run_resident:
	extcallcall skipwhite
	dec si				; -> unexpanded text
	mov di, relocateddata + 2
linkdatarelocation line_in		; -> line_in buffer

	push di
	push si
	call geterrfix
	jz @F
	mov cx, si
	sub cx, di			; = prefix length
	mov di, bx			; -> columns destination
	mov si, bx
	add si, cx			; -> columns source
	lea cx, [bx + 256]		; -> behind array
	sub cx, si			; = maximum length array (source .. end)
	rep movsb			; move it down
@@:
	pop si
	pop di

	push di
@@:
	lodsb				; load next byte
	stosb				; store byte
	cmp al, 13			; CR ?
	jne @B				; not yet -->
	pop si				; -> line_in buffer

	mov cx, relocateddata - 1
linkdatarelocation line_in.end
	xor dx, dx
	call replace

	mov si, relocateddata + 2
linkdatarelocation line_in		; -> line_in buffer
	push si
	xor cx, cx			; = 0
	db __TEST_IMM8			; (skip inc)
@@:
	inc cx				; count
	lodsb
	cmp al, 13			; CR ?
	jne @B				; not yet -->
	pop si				; -> line_in buffer
	mov byte [si - 1], cl		; set count
	extcallcall skipwhite		; load al = text byte, si -> next text
	jmp word [relocateddata]	; cannot be zero. may re-enter us
linkdatarelocation ext_preprocess_handler


set:
	lodsb
	extcallcall chkeol
	mov byte [status], bl
internaldatarelocation
	extcallcall cmd3


		; 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


replace:
reloc2	mov word [relocateddata], relocateddata
linkdatarelocation lastcmd, -4
linkdatarelocation dmycmd
	extcallcall yy_reset_buf
	lframe none
	lenter
	lvar word, end
	 push cx
	lvar word, start
	 push si
	xor cx, cx
	lvar word, errfix_start
	call geterrfix
	jz @F
	cmp dx, -1
	je @F
	dec cx
@@:
	 push bx
	lvar word, errfix_flag
	 push cx
	sub bx, strict word relocateddata + 2
linkdatarelocation line_in	; errfix array - start in line_in
				; line_in pos + bx = pos + errfix array - line_in
	add bx, dx
	lvar word, errfix_delta
	 push bx

	mov cx, si
loop:
	lodsb
.al:
	inc cx
	jz toolong
	extcallcall iseol?.notsemicolon
	je end
	cmp al, '%'
	jne loop
	lodsb
	cmp al, '%'
	je loop
%if 0
	extcallcall iseol?.notsemicolon
	je end
	cmp al, 32
	je .al
	cmp al, 9
	je .al
%endif
	call is_var_text
	jc .al
	dec cx

	lea bx, [si - 1]
	mov di, relocateddata
linkdatarelocation line_out
@@:
	extcallcall uppercase
	stosb
	lodsb
%if 0
	extcallcall iseol?.notsemicolon
	je .not
	cmp al, 32
	je .not
	cmp al, 9
	je .not
%endif
	call is_var_text
	jnc @B
	cmp al, '%'
	je .getvar

.not:
	neg bx
	add bx, si
	add cx, bx
	jc toolong
	jmp .al

.getvar:
	mov al, '='
	stosb
	call findvar
	push ss
	pop es
	add cx, di
	jc toolong
	jmp loop

end:
	mov si, word [bp + ?start]
	cmp cx, word [bp + ?end]
	ja toolong

writeloop:
	lvar word, errfix_destination
	 mov dx, si
	 add dx, word [bp + ?errfix_delta]
	 push dx
	lvar word, errfix_source
	 push dx
	mov dx, si
	mov cx, 256
	sub sp, cx
	push ss
	pop es
	mov di, sp
	push di
	rep movsb
	pop si
	mov di, dx
	jmp .loop_lod
	; db __TEST_IMM8	; skip stosb
.loop_inc:
	call .stosb_error
	inc word [bp + ?errfix_source]
	jmp .loop_lod
.loop:
	call .stosb_error
.loop_lod:
	lodsb
	jmp .chkeol
	; db __TEST_IMM8	; skip stosb
.percent_al:
	push ax
	mov al, '%'
	call .stosb_error
	pop ax
.chkeol:
	extcallcall iseol?.notsemicolon
	je writeend
	cmp al, '%'
	jne .loop
	lodsb
	cmp al, '%'
	je .loop_inc
	call is_var_text
	jc .percent_al

	houdini
	lea bx, [si - 2]
	push di
	mov di, relocateddata
linkdatarelocation line_out
@@:
	extcallcall uppercase
	stosb
	lodsb
	call is_var_text
	jnc @B
	cmp al, '%'
	je .getvar

	dec si
.not:
	push ss
	pop es
	mov cx, bx
	neg cx			; minus -> %
	add cx, si		; after candidate minus -> %
	mov si, bx		; -> %
	pop di
	push cx
	rep movsb		; plain text
	pop cx
	call .movsb_error_cx
	jmp .loop_lod

.stosb_error:
	stosb
	mov cx, 1
.movsb_error_cx:
	rol byte [bp + ?errfix_flag], 1
	jnc @F
	xchg si, word [bp + ?errfix_source]
	xchg di, word [bp + ?errfix_destination]
	rep movsb
	xchg di, word [bp + ?errfix_destination]
	xchg si, word [bp + ?errfix_source]
@@:
	retn

.getvar:
	mov al, '='
	stosb
	mov cx, relocateddata
linkdatarelocation line_out
	neg cx
	add cx, di		; -> behind equals sign minus line_out
	inc cx			; length of variable name, with percent signs
	call findvar
	 push di		; push di
	mov di, [bp + ?errfix_source]
	mov al, [di]		; al = get first %'s column
	add [bp + ?errfix_source], cx
	 pop cx			; but pop cx

	pop di
	 push si
	push es
	pop ds
	push ss
	pop es
	mov si, dx
	push cx
	rep movsb
	pop cx
	push ss
	pop ds
	 pop si
	rol byte [bp + ?errfix_flag], 1
	jnc @F
	xchg di, word [bp + ?errfix_destination]
	push si
	push di
	push cx
		; di + cx -> new destination
		; ?errfix_start + 256 - (di + cx) = length
		; ?errfix_source -> new source
	add di, cx		; -> new destination
	mov cx, [bp + ?errfix_start]
	add cx, 256		; -> past end of array
	sub cx, di		; = length
	mov si, di		; -> new destination
	cmp word [bp + ?errfix_source], di
	jae .no_move
	xchg si, [bp + ?errfix_source]
				; si -> new source, ?errfix_source -> new dest
	add di, cx
	add si, cx		; -> point after end
	call moveup
.no_move:
	pop cx
	pop di
	pop si

	rep stosb		; store first %'s column
	xchg di, word [bp + ?errfix_destination]
@@:
	jmp .loop_lod


writeend:
	add sp, 256
	mov al, 13
	call writeloop.stosb_error
	inc cx
	call writeloop.movsb_error_cx
	mov si, word [bp + ?start]
	lleave
	extcallcall skipwhite
		; di -> behind CR
	retn


toolong:
	mov ax, 0E5Bh
	extcallcall setrc
	mov dx, msg.toolong
internaldatarelocation
	extcallcall putsz
	extcallcall cmd3


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


findvar:
	push si
	push cx

	call get_env
	test dx, dx
	jz .varnotfound
	extcallcall setes2dx

	mov si, relocateddata
linkdatarelocation line_out
	mov cx, di
	sub cx, si

	xor di, di
.varloop:
	mov al, 0
	scasb
	je .varnotfound
	dec di
	push di
	push si
	push cx
@@:
	repe cmpsb
	je @F
	mov al, [es:di - 1]
	extcallcall uppercase
	cmp al, [si - 1]
	je @B
@@:
	mov dx, di
	pop cx
	pop si
	pop di
	je .varfound
	push cx
	mov al, 0
	mov cx, 7FFFh
	repne scasb
	pop cx
	je .varloop
.error:
	mov ax, 0E5Ch
	extcallcall setrc
	mov dx, msg.error
internaldatarelocation
	extcallcall putsz
	extcallcall cmd3

.varnotfound:
	pop cx
	pop si
	xor di, di
	stc
	retn

.varfound:
	mov al, 0
	mov cx, 7FFFh
	repne scasb
	jne .error
	dec di
	sub di, dx
	pop cx
	pop si
	clc
	retn


is_var_text:
	cmp al, '_'
	je .var
	cmp al, '0'
	jb .not
	cmp al, '9'
	jbe .var
	cmp al, 'A'
	jb .not
	cmp al, 'Z'
	jbe .var
	cmp al, 'a'
	jb .not
	cmp al, 'z'
	jbe .var
.not:
	stc
	retn

.var:
	clc
	retn


get_env:
	mov dx, [2Ch]
	test dx, dx
	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

	call get_es_ext
	push es
	pop ds
	xor bx, bx		; = 0 (no prior, modify ext_preprocess_handler)
	mov di, preprocess		; di -> us
internalcoderelocation
	mov si, word [ss:relocateddata]
linkdatarelocation ext_preprocess_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_preprocessed ?
	jne @F			; no -->
				; yes, reset ext_preprocess_handler to zero
.setbx:
	mov word [ss:relocateddata], bx
linkdatarelocation ext_preprocess_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_preprocess_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


error:
	extcall error

	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.run
internaldatarelocation
	call isstring?
	je run
	mov dx, msg.display
internaldatarelocation
	call isstring?
	je display
	mov dx, msg.help_keyword
internaldatarelocation
	call isstring?

help:
	lodsb
	call chkeol
	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


display:
	mov dx, -1
	call expand_to_buffer
	extcall puts
	mov al, 13
	extcall putc
	mov al, 10
	extcall putc
	call cmd3

run:
	xor dx, dx
	call skipcomma
	dec si				; -> start of source
	push si
	xor cx, cx
@@:
	inc cx				; cx = number of bytes including CR
	lodsb
	extcall iseol?.notsemicolon
	jne @B
	pop si				; -> start of content
	mov di, relocateddata + 2
linkdatarelocation line_in		; -> start of line_in
	push di

	call geterrfix
	jz @F
	push si
	push di
	add si, bx
	sub si, strict word relocateddata + 2
linkdatarelocation line_in		; -> start of source's columns
	mov di, bx			; -> columns corresponding to line_in + 2
	 push cx
	rep movsb			; move down in columns array
	 pop cx
	pop di
	pop si
@@:
	rep movsb			; move down in line_in
	pop si				; -> start of line_in

	call expand_to_buffer.si

	dec si
	dec si
	mov byte [si], cl
	mov word [buffer_start], si
internaldatarelocation

	mov ax, word [relocateddata]
linkdatarelocation ext_inject_handler
	mov word [priorinject], ax
internaldatarelocation

	call get_es_ext
	setopt [es:code + eldiFlags], eldifResident
internalcoderelocation -3		; mark block as resident

	mov word [relocateddata], .inject
linkdatarelocation ext_inject_handler, -4
internalcoderelocation
	call cmd3

.inject:
	houdini

	mov di, relocateddata + 1
linkdatarelocation line_in
	mov si, word [buffer_start]
internaldatarelocation

	extcall yy_reset_buf
	push di
	mov cx, words(256)
	rep movsw
	pop si

	mov ax, word [priorinject]
internaldatarelocation
	mov word [relocateddata], ax
linkdatarelocation ext_inject_handler

	inc si
	extcall skipwhite

	call get_es_ext
	clropt [es:code + eldiFlags], eldifResident
internalcoderelocation -3		; mark block as free
	 push ss
	 pop es

	extcall cmd3_injected


		; INP:	si -> separator after keyword
		;	dx = FFFFh if to display
		;	dx = 0 else
		; OUT:	branches to cmd3 if too long
		;	returns if fits in buffer
		;	dx -> text, up to 255 bytes + CR
		;	cx = length of text excluding CR
		;	si = dx + 1
		;	dx may be != buffer.main
expand_to_buffer:
	call skipcomma
	dec si
.si:
	mov cx, 256
	mov di, buffer.main
internaldatarelocation
	test dx, dx
	jnz @F
	mov dx, si
	sub dx, di
		; line_in start - buffer
		; use as buffer offset + line_in - buffer
@@:
	push di
	db __TEST_IMM8
@@:
	stosb
	lodsb
	cmp al, 13
	loopne @B
	jne toolong
	stosb
	pop si
	mov cx, buffer.end - 1
internaldatarelocation
	call replace
	mov cx, di
	sub cx, si
	mov dx, si
	dec dx
	retn


	usesection DATA
status:			db 0FFh

msg:
.variables:		asciz "VARIABLES"
.variable:		asciz "VARIABLE"
.uninstall_done:	db "VARIABLES uninstalled."
%if _ELD_RECLAIM_HINT
			db " (Don't forget to use reclaim.eld)"
%endif
			asciz 13,10
.uninstall_error:	asciz "VARIABLES unable to uninstall!",13,10
.toolong:		asciz "VARIABLES expansion is too long!",13,10
.error:			asciz "VARIABLES detected invalid environment!",13,10
.on:			asciz "ON"
.off:			asciz "OFF"
.run:			asciz "RUN"

uinit_data: equ $

.display:	asciz "DISPLAY"
.help_keyword:	asciz "HELP"
.installed:	asciz "VARIABLES installed.",13,10
.help:		db "Install this ELD using the INSTALL keyword parameter.",13,10
		db 13,10
		db "Use %variable% in commands to do variable substitution.",13,10
		db "Run as VARIABLES UNINSTALL to uninstall this ELD.",13,10
		asciz

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

	absolute uinit_data
resident_data:

	alignb 2
priorinject:	resw 1
buffer_start:	resw 1
	resb 1			; align main buffer
buffer:
.length:	resb 1
.main:		resb 256
.end:
		resb 2		; just in case there's an off-by-one

	alignb 16
uinit_data_end:

	absolute resident_data

	alignb 16
resident_data_end:
resident_data_size equ resident_data_end - datastart

%if uinit_data_end >= init_data_end
 total_data_size equ uinit_data_end - 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 (total_data_size - (resident_data_end - datastart)) > 0
	mov ax, total_data_size - (resident_data_end - datastart)
	sub word [es:code + eldiEndData], ax
internalcoderelocation		; adjust size
	sub word [relocateddata], ax
linkdatarelocation extdata_used	; adjust size
%endif

	mov bx, word [relocateddata]
linkdatarelocation ext_preprocess_handler
				; -> prior
	mov di, preprocess		; -> our handler
internalcoderelocation
	test bx, bx		; installing as first ?
	jz .only_first		; yes, simple --> (leave as extcall cmd3_preprocessed)
	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], preprocess
linkdatarelocation ext_preprocess_handler, -4
internalcoderelocation		; -> our entrypoint

	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
