
; Public Domain

; test run command: get 5; .; .

%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
header_extension_end:
	iend

description:		asciz "Display or change DOS 32-bit seek of a process handle."


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


start:
	 push ss
	 pop es
	extcallcall skipcomma

	extcallcall InDOS
	jz @F
.error:
	extcallcall error

@@:

	extcallcall iseol?
	je help

	dec si
	mov dx, msg.get
internaldatarelocation
	extcallcall isstring?
	je get
	mov dx, msg.set
internaldatarelocation
	extcallcall isstring?
	je set
	jmp error

parsehandle:
	extcallcall close_ext
	extcallcall skipcomma
	extcallcall getword
	retn

dup:
	mov dx, word [relocateddata]
linkdatarelocation pspdbe
	extcallcall setes2dx

	mov dx, word [es:34h + 2]
	mov bx, word [es:34h]
	mov cx, word [es:32h]
	cmp ax, cx
	jae .beyondpht
	extcallcall setes2dx
	add bx, ax
	mov ah, byte [es:bx]
	cmp ah, -1
	je .closedpht

	mov dx, word [relocateddata]
linkdatarelocation pspdbg
	extcallcall setes2dx

	mov dx, word [es:34h + 2]
	mov bx, word [es:34h]
	mov si, bx
	mov cx, word [es:32h]
	extcallcall setes2dx
	test cx, cx
	jz .nofreehandle
@@:
	es lodsb
	cmp al, -1
	loopne @B
	jne .nofreehandle
	dec si
	neg bx
	add bx, si		; = handle number we're patching

		; critical section
	mov byte [es:si], ah	; patch handle into debugger PHT
	mov ah, 45h
	extcallcall _doscall	; DUP the handle
	mov byte [es:si], -1	; undo patch
	jc .duperror
	mov word [relocateddata], ax
linkdatarelocation ext_handle	; store DUP handle
		; end of critical section
	push ss
	pop es

	db __TEST_IMM8		; NC, skip stc
@@:
	stc
	retn

.beyondpht:
	push cx
	mov di, relocateddata
linkdatarelocation line_out

	mov si, msg.handle
internaldatarelocation
	extcallcall copy_single_counted_string
	mov ax, word [originalhandle]
internaldatarelocation
	extcallcall decword

	mov si, msg.beyondpht
internaldatarelocation
	extcallcall copy_single_counted_string
	pop ax
	extcallcall decword
	extcallcall putsline_crlf
	mov ax, 0E28h
	extcallcall setrc
	jmp @B

.closedpht:
	mov di, relocateddata
linkdatarelocation line_out

	mov si, msg.handle
internaldatarelocation
	extcallcall copy_single_counted_string
	mov ax, word [originalhandle]
internaldatarelocation
	extcallcall decword

	mov si, msg.closedpht
internaldatarelocation
	extcallcall copy_single_counted_string
	extcallcall putsline_crlf
	mov ax, 0E29h
	extcallcall setrc
	jmp @B

.nofreehandle:
	mov dx, msg.nofreehandle
internaldatarelocation
	extcallcall putsz
	mov ax, 0E2Ah
	extcallcall setrc
	jmp @B

.duperror:
	mov dx, msg.duperror
internaldatarelocation
	extcallcall putsz
	mov ax, 0E2Bh
	extcallcall setrc
	jmp @B


set:
	call parsehandle
	push dx
	extcallcall skipcomm0
	dec si
	mov cx, 4200h
	mov dx, msg.abs
internaldatarelocation
	extcallcall isstring?
	je .got
	inc cx
	mov dx, msg.cur
internaldatarelocation
	extcallcall isstring?
	je .got
	inc cx
	mov dx, msg.eof
internaldatarelocation
	extcallcall isstring?
	je .got
	jmp error

.got:
	lodsb
	extcallcall getdword
	extcallcall chkeol
	pop ax

	push bx
	push dx
	push cx
	mov word [originalhandle], ax
internaldatarelocation

	call dup
	xchg bx, ax
	pop ax
	pop dx
	pop cx
	jc .ret

	extcallcall _doscall
	jc .ioerror
	extcallcall close_ext

.ret:
@@:
	call uninstall_oneshot
	xor ax, ax
	retf

.ioerror:
	mov dx, msg.ioerrorset
internaldatarelocation
	extcallcall putsz
	mov ax, 0E2Ch
	extcallcall setrc
	jmp @B


get:
	call parsehandle
	extcallcall skipcomm0
	dec si
	push dx
	mov dx, msg.var
internaldatarelocation
	extcallcall isstring?
	lodsb
	jne .notvar
	call getword
	cmp dx, strict word relocateddata
linkdatarelocation vregs.amount, -2, optional
	jae error
	mov word [var], dx
internaldatarelocation

	extcallcall skipcomm0
	dec si
	mov dx, msg.quiet
internaldatarelocation
	extcallcall isstring?
	lodsb
	jne .notvar
	not byte [quiet]
internaldatarelocation
.notvar:
	extcallcall chkeol
	pop ax

	mov word [originalhandle], ax
internaldatarelocation

	call dup
	jc .ret
	xchg bx, ax
	mov di, relocateddata
linkdatarelocation line_out

	mov si, msg.handle
internaldatarelocation
	extcallcall copy_single_counted_string
	mov ax, word [originalhandle]
internaldatarelocation
	extcallcall decword

	mov si, msg.seek
internaldatarelocation
	extcallcall copy_single_counted_string

	mov ax, 4201h
	xor cx, cx
	xor dx, dx
	extcallcall _doscall
	jc .ioerror

	mov bx, word [var]
internaldatarelocation
	cmp bx, -1
	je @F
	add bx, bx
	add bx, bx
	mov si, relocateddata
linkdatarelocation vregs, -2, optional
	test si, si
	jz error
	mov word [si + bx], ax
	mov word [si + bx + 2], dx
@@:

	rol byte [quiet], 1
internaldatarelocation
	jc @F

	xchg dx, ax
	extcallcall hexword
	mov byte [di], '_'
	inc di
	xchg dx, ax
	extcallcall hexword
	mov word [di], 2020h
	scasw
	mov byte [di], '#'
	inc di
	extcallcall decdword
	mov word [di], 2020h
	scasw
	mov cx, 1
	mov bx, 4+4
	extcallcall disp_dxax_times_cx_width_bx_size.store
	extcallcall putsline_crlf

@@:
	extcallcall close_ext

.ret:
@@:
	call uninstall_oneshot
	xor ax, ax
	retf

.ioerror:
	mov dx, msg.ioerrorget
internaldatarelocation
	extcallcall putsz
	mov ax, 0E2Dh
	extcallcall setrc
	jmp @B

help:
	mov dx, msg.help
internaldatarelocation
	extcallcall 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:

var:			dw -1
quiet:			db 0

msg:
.get:			asciz "GET"
.var:			asciz "VAR"
.quiet:			asciz "QUIET"
.set:			asciz "SET"
.abs:			asciz "ABS"
.cur:			asciz "CUR"
.eof:			asciz "EOF"
.handle:		counted "Process handle "
.seek:			counted " current seek is "
.beyondpht:		counted " is beyond PHT size "
.closedpht:		counted " is closed"
.nofreehandle:		asciz "No free process handle in the debugger process!",13,10
.duperror:		asciz "DUP error in the debugger process!",13,10
.ioerrorget:		asciz "Got I/O error trying to query current seek!",13,10
.ioerrorset:		asciz "Got I/O error trying to seek!",13,10

uinit_data: equ $

.help:	db "Call with GET <handlenumber> [VAR <index> [QUIET]]",13,10
	db "Call with SET <handlenumber> [ABS|CUR|EOF] <offset>",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
originalhandle:		resw 1

	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
