
; Public Domain

; test run command: ; .; .

%include "lmacros3.mac"

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

%assign _BOOTLDR 1
%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
at eldhxHelpOffset,		dd DATAOFFSET + msg.help - datastart
PUT_ELDHX_DATETIME_OFFSET
header_extension_end:
	iend

description:		asciz "Set up EXTNAME library pathname."


	align 16, db 0

	eldstrict on

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 "ENAMELIB"
at eldiListing,		asciz _ELD_LISTING
	iend


		; INP:	-
		; OUT:	NC if found,
		;	 ss:bp = di -> lib name variable
		;	 dx = length of buffer
		;	CY if error,
		;	 ax = RC
		;	 dx -> ASCIZ error message
		; CHG:	ax, dx, bp, di, bx, cx, si
		; STT:	ss = ds = es
find:
	xor ax, ax
.loop:
reloc	cmp word [relocateddata], ax
linkdatarelocation extseg_used
	ja @F

.notfound:
	mov ax, 0E74h
reloc	mov dx, msg.notfound
internaldatarelocation
	jmp .ret_CY

@@:
reloc	mov bx, relocateddata
linkdatarelocation extdssel, -2, optional
	extcallcall ispm
	jz @F
reloc	mov bx, relocateddata
linkdatarelocation extseg, -2, optional
@@:
	test bx, bx
	jnz @F
.error:
	mov ax, 0E75h
reloc	mov dx, msg.error
internaldatarelocation
	jmp .ret_CY

@@:
	mov es, word [bx]
	mov bx, ax
	cmp word [es:bx + eldiStartCode], ax
	jne .error
	mov dx, ax
	add dx, ELD_INSTANCE_size
	jc .error
	cmp word [es:bx + eldiEndCode], dx
	jb .error
reloc	mov dx, word [relocateddata]
linkdatarelocation extseg_used
	cmp word [es:bx + eldiEndCode], dx
	ja .error
	je @F
	sub dx, ELD_INSTANCE_size
	jc .error
	cmp word [es:bx + eldiEndCode], dx
	ja .error
@@:
	mov dx, word [es:bx + eldiEndCode]
	mov bp, dx
	sub dx, ax
	jc .error
	push word [es:bx + eldiStartData]
	push bx
	mov bx, word [es:bx + eldiEndData]
		; bx -> end data
	pop si
	testopt [es:si + eldiFlags], eldifResident
	lea si, [si + eldiIdentifier]
	push es
	pop ds
		; ds:si -> id
	 push ss
	 pop es
	 	; es => data entry
	pop cx
		; cx -> start data
	jz .next

	push cx
	mov cx, words(8)
reloc	mov di, msg.extname_signature
internaldatarelocation
	repe cmpsw
	pop cx
	jne .next

	lea si, [si - (eldiIdentifier + 8) + ELD_INSTANCE_size]
	push cx
	mov cx, words(8)
reloc	mov di, msg.namelib0_signature
internaldatarelocation
	repe cmpsw
	pop cx
	je .got

	mov ax, 0E76h
reloc	mov dx, msg.notsupported
internaldatarelocation
.ret_CY:
	stc
.ret:
	push ss
	pop ds
	push ss
	pop es
	retn

.got:
	cmp word [si], bx
	jae .invalid
	cmp word [si + 2], bx
	ja .invalid
	cmp word [si], cx
	jb .invalid
	cmp word [si + 2], cx
	jbe .invalid

	mov di, word [si]
	mov bp, di
	mov dx, word [si + 2]
	sub dx, di
	jnc .ret
.invalid:
	mov ax, 0E77h
reloc	mov dx, msg.invalid
internaldatarelocation
	jmp .ret_CY

.next:
	push ss
	pop ds
	test bp, bp
	mov ax, bp
	jnz .loop
	jmp .notfound


yname:
	extcallcall skipcomma
	dec si
reloc	mov dx, msg.quiet
internaldatarelocation
	extcallcall isstring?
	jne .loud
.quiet:
reloc	or byte [quiet], -1
internaldatarelocation -3
@@:
.loud:
	extcallcall skipcomma
	push si
	call find			; di -> length dx
	pop si
	jnc @F
	jmp .error
@@:
	push di
	push dx				; = length of buffer
	extcallcall yy_common_parse_name
	pop cx				; = length of buffer
	inc di				; -> after NUL
	sub di, bx			; = length of string
	cmp cx, di			; buffer large enough ?
	mov cx, di			; cx = length of string
	pop di
	jb .unable
	extcallcall chkeol
	mov si, bx			; -> yy name
	rep movsb
	jmp mcp.done

.unable:
	mov ax, 0E7Eh
reloc	mov dx, msg.unable.yname
internaldatarelocation
.error:
	jmp mcp.error


truename:
	extcallcall skipcomma
	dec si
reloc	mov dx, msg.quiet
internaldatarelocation
	extcallcall isstring?
	jne .loud
.quiet:
reloc	or byte [quiet], -1
internaldatarelocation -3
@@:
.loud:
	extcallcall skipcomma
	push si
	call find			; di -> length dx
	pop si
	jnc @F
	jmp .error
@@:
	cmp dx, 128
	jb .unable
	extcallcall InDOS
	jnz .indos
	push di
	extcallcall yy_common_parse_name
	pop di
	extcallcall chkeol
	mov si, bx

reloc	mov dx, [relocateddata]
linkdatarelocation pspdbg
	call call_60_es_dpr_ds_dx
	jc .unable
	jmp mcp.done

.unable:
	mov ax, 0E7Ch
reloc	mov dx, msg.unable.truename
internaldatarelocation
	jmp .error

.indos:
	mov ax, 0E7Dh
reloc	mov dx, msg.indos.truename
internaldatarelocation
.error:
	jmp mcp.error


run:
	extcallcall skipcomma
	extcallcall iseol?
	je @F
	dec si
reloc	mov dx, msg.mcp
internaldatarelocation
	extcallcall isstring?
	je mcp
reloc	mov dx, msg.quiet
internaldatarelocation
	extcallcall isstring?
	je runquiet
reloc	mov dx, msg.truename
internaldatarelocation
	extcallcall isstring?
	je truename

reloc	mov dx, msg.yname
internaldatarelocation
	extcallcall isstring?
	je yname
errorj1:
	jmp error

runquiet:
reloc	or byte [quiet], -1
internaldatarelocation -3
	extcallcall skipcomma
	extcallcall iseol?
	je mcp.quiet
	dec si
reloc	mov dx, msg.mcp
internaldatarelocation
	extcallcall isstring?
	je mcp.quieteol
reloc	mov dx, msg.truename
internaldatarelocation
	extcallcall isstring?
	je truename.quiet
reloc	mov dx, msg.yname
internaldatarelocation
	extcallcall isstring?
	je yname.quiet
	jmp errorj1

mcp:
	extcallcall skipcomma
	extcallcall iseol?
	je @F
	dec si
reloc	mov dx, msg.quiet
internaldatarelocation
	extcallcall isstring?
	jne errorj1
.quieteol:
	lodsb
	extcallcall chkeol
.quiet:
reloc	or byte [quiet], -1
internaldatarelocation -3
@@:
	call find			; di -> length dx
	jnc @F
.error:
	push ss
	pop es
	push ss
	pop ds
	extcallcall setrc
reloc	rol byte [quiet], 1
internaldatarelocation
	jc .ret
	extcallcall putsz
.ret:
	jmp done

@@:
reloc	mov si, relocateddata
linkdatarelocation init_executable_pathname, -2, optional
	test si, si
	jz @F
reloc	mov bx, relocateddata
linkdatarelocation init_executable_pathname.end, -2, optional
	test bx, bx
	jz @F
	mov cx, [bx]
	sub cx, si
	je @F			; empty -->
	jb .unable.exec		; .end points below start, invalid -->
	inc cx
	cmp dx, cx
	jb .unable.exec
	rep movsb
	jmp .done

.unable.exec:
	mov ax, 0E7Bh
reloc	mov dx, msg.unable.exec
internaldatarelocation
	jmp .error

@@:

reloc	testopt [relocateddata], nodosloaded
linkdatarelocation internalflags, -3
	jnz .boot

reloc	testopt [relocateddata], dif6_device_mode
linkdatarelocation internalflags6, -3
	jnz .device

.application:
	cmp dx, 128
	jb .unable.app
	extcallcall InDOS
	jnz truename.indos

	mov dx, word [2Ch]
	test dx, dx
	jz .unable.app
	extcallcall setes2dx

	mov cx, 8000h
	xor si, si
@@:
	call .nextvar
	jc .unable.app
	jne @B
	inc si
	es lodsw
	cmp ax, 1
	jne .unable.app

	push es
	pop ds				; => env
	push ss
	pop es				; => data entry
	call call_60_es_dpr_ds_dx
	jc .unable.app
	jmp .done


.unable.app:
	mov ax, 0E7Ah
reloc	mov dx, msg.unable.app
internaldatarelocation
	jmp .error

.nextvar:
@@:
	es lodsb
	test al, al
	loopnz @B
	stc
	jnz @F
	cmp byte [es:si], 0
@@:
	retn


.device:
	cmp dx, 128
	jb .unable.device

	extcallcall InDOS
	jnz truename.indos

	extcallcall ispm
	jz .unable.device

reloc	mov si, relocateddata
linkdatarelocation reg_eax
reloc	mov di, relocateddata
linkdatarelocation device_quittable_regs, -2, optional
	test di, di
	jz .unable.device
	mov cx, words(64)
	repe cmpsw
	jne .unable.device

reloc	mov bx, relocateddata
linkdatarelocation device_header_address, -2, optional
	test bx, bx
	jz .unable.device
	les di, [bx]
	mov al, -1
	mov cl, 4
	repe scasb		; is next device pointer still -1 ?
	push ss
	pop es
	jne .unable.device

reloc	mov si, word [relocateddata]
linkdatarelocation reg_ebx
reloc	mov ds, word [relocateddata]
linkdatarelocation reg_es
	lds si, [si + 12h]

	mov di, si
@@:
	lodsb
	cmp al, 32
	je @F
	cmp al, 9
	je @F
	cmp al, 0
	je @F
	cmp al, 13
	je @F
	cmp al, 10
	je @F
	jmp @B

@@:
	push word [si - 1]
	push si
	mov byte [si - 1], 0
	mov si, di
	mov di, bp
	mov ah, 60h
	int 21h
	pop si
	pop ax
	mov byte [si - 1], al
	jnc .done

.unable.device:
	mov ax, 0E79h
reloc	mov dx, msg.unable.dev
internaldatarelocation
	jmp .error

.boot:
reloc	mov si, relocateddata
linkdatarelocation boot_init_foundname, -2, optional
	test si, si
	jnz @F

.unable.boot:
	mov ax, 0E78h
reloc	mov dx, msg.unable.boot
internaldatarelocation
	jmp .error

@@:
	cmp byte [si], 0
	je .unable.boot

	xor cx, cx
	mov bx, si
@@:
	lodsb
	inc cx
	test al, al
	jnz @B

	sub dx, 4
	jc .unable.boot
	cmp dx, cx
	jb .unable.boot

reloc	mov si, msg.ldpslash
internaldatarelocation

	movsw
	movsw

	mov si, bx
	rep movsb

.done:
	push ss
	pop es
	push ss
	pop ds
reloc	rol byte [quiet], 1
internaldatarelocation
	jc .skipmsg
reloc	mov dx, msg.done.1
internaldatarelocation
	extcallcall putsz
	mov dx, bp
	extcallcall putsz
reloc	mov dx, msg.done.2
internaldatarelocation
	extcallcall putsz
.skipmsg:
	jmp done


call_60_es_dpr_ds_dx:
	mov ah, 60h
	extcallcall ispm
	jnz .86mode
.pm:
subcpu 286
reloc	push word [ss:relocateddata]
linkdatarelocation pspdbg		; es
	push dx				; ds
	push word 21h
	push bp
	call intcall_return_parameter_es_parameter_ds
	pop cx				; discard ds
	pop cx				; discard es
	jmp @F
subcpureset
.86mode:
	int 21h
@@:
	retn


subcpu 286
intcall_return_parameter_es_parameter_ds:
	lframe near
	lpar word, es_value
	lpar word, ds_value
	lpar_return
	lpar word, int_number
	lpar word, bp_value
	lvar 32h, 86m_call_struc
	lenter
	push es
	mov word [bp + ?86m_call_struc +00h], di	; edi
	mov word [bp + ?86m_call_struc +04h], si	; esi
	mov word [bp + ?86m_call_struc +10h], bx	; ebx
	mov word [bp + ?86m_call_struc +14h], dx	; edx
	mov word [bp + ?86m_call_struc +18h], cx	; ecx
	mov word [bp + ?86m_call_struc +1Ch], ax	; eax
	mov ax, word [bp + ?bp_value]
	mov word [bp + ?86m_call_struc +08h], ax	; bp
	mov al, 0					; (preserve flags!)
	lahf
	xchg al, ah
	mov word [bp + ?86m_call_struc +20h], ax	; flags
	xor ax, ax
	mov word [bp + ?86m_call_struc +0Ch + 2], ax
	mov word [bp + ?86m_call_struc +0Ch], ax
	mov word [bp + ?86m_call_struc +2Eh], ax	; sp
	mov word [bp + ?86m_call_struc +30h], ax	; ss
	mov ax, word [bp + ?es_value]			; usually [pspdbg]
	mov word [bp + ?86m_call_struc +22h], ax	; es
	mov ax, word [bp + ?ds_value]			; usually [pspdbg]
	mov word [bp + ?86m_call_struc +24h], ax	; ds
	push ss
	pop es				; => stack
	lea di, [bp + ?86m_call_struc]	; -> 86-Mode call structure
reloc	testopt [relocateddata], 8000h
linkdatarelocation internalflags, -3
	jz @F
subcpu 386
	movzx edi, di			; (previously checked b[dpmi32] here)
subcpureset
@@:

	mov bx, word [bp + ?int_number]			; int#
	xor cx, cx
	mov ax, 0300h
	int 31h
	mov ah, byte [bp + ?86m_call_struc +20h]	; flags
	sahf
	mov di, word [bp + ?86m_call_struc +00h]	; edi
	mov si, word [bp + ?86m_call_struc +04h]	; esi
	mov bx, word [bp + ?86m_call_struc +10h]	; ebx
	mov dx, word [bp + ?86m_call_struc +14h]	; edx
	mov cx, word [bp + ?86m_call_struc +18h]	; ecx
	mov ax, word [bp + ?86m_call_struc +1Ch]	; eax
	push word [bp + ?86m_call_struc +22h]		; return es value
	pop word [bp + ?es_value]			;  in the parameter
	push word [bp + ?86m_call_struc +24h]		; return ds value
	pop word [bp + ?ds_value]			;  in the parameter
	pop es
	lleave
	lret
subcpureset


extcallcall error

start:
	mov bx, es
	 push ss
	 pop es
	extcallcall skipcomma
	dec si
reloc	mov dx, relocateddata
linkdatarelocation msg.run
	extcallcall isstring?
	je run
reloc	mov dx, msg.keyword_help
internaldatarelocation
	extcallcall isstring?
	jmp help

@@:
done:
	call uninstall_oneshot
	xor ax, ax
	retf

help:
	lodsb
	extcallcall chkeol
reloc	mov dx, msg.help
internaldatarelocation
	extcallcall putsz
	jmp @B


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


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

msg:

	align 2, db 0
.extname_signature:	fill 8, 32, db "EXTNAME"
.namelib0_signature:	db "NAMELIB0"
.keyword_help:		asciz "HELP"
.run:			asciz "RUN"
.mcp:			asciz "MCP"
.truename:		asciz "TRUENAME"
.yname:			asciz "YNAME"
.quiet:			asciz "QUIET"
.ldpslash:		db "ldp/"
.error:			asciz "Error in ELD instance structures!",13,10
.notfound:		asciz "EXTNAME ELD instance not found!",13,10
.notsupported:		asciz "EXTNAME ELD instance found does not support us!",13,10
.invalid:		asciz "EXTNAME ELD instance has invalid data pointers!",13,10
.done.1:		asciz 'Library string set to "'
.done.2:		asciz '"',13,10
.unable.yname:		asciz "Unable to use yy name of pathname!",13,10
.unable.truename:	asciz "Unable to use truename of pathname!",13,10
.indos.truename:	asciz "Truename requires DOS call!",13,10
.unable.exec:		asciz "Unable to use executable variable!",13,10
.unable.app:		asciz "Unable to find application executable!",13,10
.unable.dev:		asciz "Unable to find device executable!",13,10
.unable.boot:		asciz "Unable to find boot executable!",13,10
.help:		db "This ELD can only be used transiently.",13,10
		db 13,10
		db "Run with RUN to set EXTNAME ELD's library string.",13,10
		db 13,10
		db "Run with RUN QUIET to disable output.",13,10
		asciz

quiet:		db 0

uinit_data: equ $

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

	absolute uinit_data

	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

%include "eldlink.asm"

	align 16
code_size equ $ - code
