
; Public Domain
;
; This file contains an %include directive that references
;  a file named font.asm. This file is available as:
;
; Font bitmaps from "VileR", (CC BY-SA 4.0)
; https://int10h.org/oldschool-pc-fonts/

; test install command: install; dbitmap 100 l 8; dbitmap uninstall
; test run command: 100 l 8; .; .

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

%assign _CATCHINT0C 0
%assign _CATCHINT0D 0
%assign _CATCHINTFAULTCOND 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 "Provide DBITMAP command."


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

	mov dx, msg.dbitmap
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
	mov bx, text_0
internaldatarelocation
	mov dx, msg.set0
internaldatarelocation
	extcallcall isstring?
	je setcommand
	mov bx, text_1
internaldatarelocation
	mov dx, msg.set1
internaldatarelocation
	extcallcall isstring?
	je setcommand

	call run
	extcallcall cmd3


setcommand:
@@:
	extcallcall skipcomma
	cmp al, '='
	je @B
	mov bp, relocateddata + text_buffer_length - 1
linkdatarelocation line_out
	call getstr_text
	extcallcall chkeol
	call copytext
	extcallcall cmd3

copytext:
	push si
	mov si, relocateddata
linkdatarelocation line_out
	mov cx, di		; -> behind string
	sub cx, si		; = length
	mov di, bx		; -> destination
	mov al, cl
	stosb			; store length
	rep movsb		; store text
	pop si
	retn


errorj2a:
	jmp error

;	GETSTR - Get string of bytes.  Put the answer in line_out.
;		Entry	AL	first character
;			SI	address of next character
;			BP	limit in line_out
;		Exit	[line_out] first byte of string
;			DI	address of last+1 byte of string
;		Uses	AX, cx, dx,SI
getstr_text:
	mov di, relocateddata
linkdatarelocation line_out
.append:
	extcallcall skipcomm0
	extcallcall iseol?
	je short errorj2a	; we don't allow empty byte strings

getstr_loop:
	extcallcall skipcomm0
	cmp al, "'"
	je getstr_start_quote	; if string
	cmp al, '"'
	je getstr_start_quote	; ditto

	cmp di, bp
	ja errorj2a

	extcallcall getbyte	; byte in DL
	mov byte [di], dl	; store the byte
	inc di
	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 short errorj2a	; if end of line
getstr_store_quoted:
	cmp di, bp
	ja errorj2a

	stosb			; save character and continue
	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
	mov dx, msg.end
internaldatarelocation
	extcallcall isstring?
	lodsb
	jne getstr_loop			; if not done yet
.ret:
	retn


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


%assign _PM 1
%assign _ONLY386 0
%assign _ONLYNON386 0
%define lDEBUG_CODE CODE
%define lDEBUG_DATA_ENTRY DATA
%assign _WPT_LABELS 0

%include "386.mac"

run:
	push cx
	push si
	mov si, text_0
internaldatarelocation
	mov cx, text_both_length
	mov di, current_text_0
internaldatarelocation
	rep movsb
	mov word [hide_addresses], cx
internaldatarelocation
	pop si
	pop cx

	extcallcall skipcomma
	dec si
	mov dx, msg.run
internaldatarelocation
	extcallcall isstring?

@@:
	extcallcall skipcomma
	dec si
	mov bx, current_text_0
internaldatarelocation
	mov dx, msg.set0
internaldatarelocation
	extcallcall isstring?
	je .set
	mov bx, current_text_1
internaldatarelocation
	mov dx, msg.set1
internaldatarelocation
	extcallcall isstring?
	je .set
	mov dx, msg.str
internaldatarelocation
	extcallcall isstring?
	je .str
	mov dx, msg.noadr
internaldatarelocation
	extcallcall isstring?
	je .noadr
	jmp @F

.set:
	extcallcall skipcomma
	cmp al, '='
	je .set
	mov bp, relocateddata + text_buffer_length - 1
linkdatarelocation line_out
	call getstr_text
	call copytext
	dec si
	jmp @B

.str:
	mov byte [display_string], -1
internaldatarelocation -3
.noadr:
	mov byte [hide_addresses], -1
internaldatarelocation -3
	jmp @B

@@:
	rol byte [display_string], 1
internaldatarelocation
	jc string

	_386_o32		; mov ecx
	mov cx, 8
_386	dw 0			; extend mov imm32 immediate to 32 bits
	mov dx, msg.internal
internaldatarelocation
	extcallcall isstring?
	lodsb
	jne @F
	extcallcall getword
	mov bx, ss
	add dx, strict word table
internaldatarelocation
	jc error
_386	movzx edx, dx
	jmp @FF

@@:
	mov bx, word [relocateddata]
linkdatarelocation reg_ds
_386	xor edx, edx		; ecxh = 0 and edxh = 0
	extcallcall getrangeX
	_386_o32
	sub cx, dx
	_386_o32
	inc cx
@@:
	extcallcall chkeol

	_386_o32
	mov si, dx

.loop:
	mov di, relocateddata
linkdatarelocation line_out
	rol byte [hide_addresses], 1
internaldatarelocation
	jc .noaddress

	mov ax, bx
	extcallcall hexword
	mov al, ':'
	stosb
	extcallcall test_high_limit
	jz @F
_386	push esi
_386	pop si
_386	pop ax
	extcallcall hexword
@@:
	mov ax, si
	extcallcall hexword

	mov ax, 2020h
	stosw

.noaddress:
	mov ds, bx
	_386_a32
	lodsb
	push ss
	pop ds

	mov bp, relocateddata - text_buffer_length
linkdatarelocation line_out_end
	call singleline
	extcallcall test_high_limit
_386	jnz @F
_386	movzx esi, si
@@:
	push bx
	push cx
	extcallcall putsline_crlf
	pop cx
	pop bx
	loop .loop
	retn


string:
	houdini
	lodsb
	mov bp, relocateddata - 1
linkdatarelocation line_out_end
	call getstr_text
	extcallcall chkeol

	mov si, relocateddata
linkdatarelocation line_out
	mov cx, di		; -> behind string
	sub cx, si		; = length

	xor di, di		; address first line (up to eigth)

.outerloop:
	push cx			; preserve length of string
.loop:
	lodsb
	cmp al, '\'
	jne .noescape
	loop @F
	jmp .outernext
@@:
	lodsb
	cmp al, '\'
	je .noescape		; (escaped backslash)
	extcallcall uppercase
	cmp al, 'H'
	jne @FF
	loop @F
	jmp .outernext
@@:
	lodsb
	extcallcall uppercase
	sub al, '0'
	cmp al, 9
	jbe .decdigit
	sub al, 'A' - ('9' + 1)
.decdigit:
	mov ah, 0
	xchg dx, ax
	xor ax, ax
	push di
	mov di, buffer
internaldatarelocation
	test dx, dx
	jz .display
	mov bp, buffer.end - text_buffer_length
internaldatarelocation
	call singleline.dx
	jmp .display

@@:
	cmp al, 'M'
	jne .noescape		; (unknown escape)
	loop @F
	jmp .outernext
@@:
	lodsb
	call .address
		; bit mirror
	push si
	push cx
	mov cx, 8		; process 8 bytes
	mov si, bx		; -> buffer
@@:
	lodsb			; al = byte
	 push cx
	mov cx, 8		; process 8 bits
@@:
	shr al, 1		; CF = low bit
	rcl ah, 1		; rotate CF into ah
	loop @B
	 pop cx
	mov byte [si - 1], ah	; write bit mirrored byte
	loop @BB
	pop cx
	pop si
	jmp @F

.noescape:
	call .address
@@:
	mov al, byte [bx + di]	; load byte
	push di
	mov di, buffer
internaldatarelocation
	mov bp, buffer.end - text_buffer_length
internaldatarelocation
	call singleline
.display:
	 push cx
	mov cx, di
	mov dx, buffer
internaldatarelocation
	sub cx, dx
	extcallcall puts	; write string for this byte
	 pop cx
	pop di

	loop .loop
.outernext:
	mov dx, msg.crlf
internaldatarelocation
	extcallcall putsz
	pop cx
	mov si, relocateddata
linkdatarelocation line_out
	inc di
	cmp di, 8
	jb .outerloop
	extcallcall cmd3


.address:
	mov bx, buffer
internaldatarelocation		; bx -> buffer
	mov ah, 8
	mul ah			; al times 8
	add ax, strict word table
internaldatarelocation		; -> table entry
	jc error
	xchg si, ax		; si -> table entry
	push di
	mov di, bx		; di -> buffer
	movsw
	movsw
	movsw
	movsw
	xchg si, ax
	pop di
	retn


singleline:
	mov dx, 8
.dx:
	push si
	push cx
	mov ah, al
.innerloop:
	mov si, current_text_1
internaldatarelocation
	shl ah, 1
	jc @F
	mov si, current_text_0
internaldatarelocation
@@:
	cmp bp, di
	jb error
	extcallcall copy_single_counted_string
	dec dx
	jnz .innerloop
	pop cx
	pop si
	retn


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
	mov dx, code
internalcoderelocation
	testopt [relocateddata], has386
linkdatarelocation internalflags, -3
	jz @F
	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

@@:
	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:
	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
	mov dx, relocateddata
linkdatarelocation msg.install
	call isstring?
	je install

	mov dx, msg.help_noun
internaldatarelocation
	call isstring?
	je help

	call iseol?
	je help

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

help:
	call chkeol
	mov dx, msg.help
internaldatarelocation
	extcall putsz
	jmp @B


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


	usesection DATA

table:
	%include "font.asm"

text_buffer_length equ 10

text_0:		db 1
		fill text_buffer_length, 32, db '.'
text_1:		db 1
		fill text_buffer_length, 32, db '*'
text_both_length equ $ - text_0

msg:
.dbitmap:		asciz "DBITMAP"
.uninstall_done:	db "DBITMAP command uninstalled."
%if _ELD_RECLAIM_HINT
			db " (Don't forget to use reclaim.eld)"
%endif
.crlf:			asciz 13,10
.uninstall_error:	asciz "DBITMAP command unable to uninstall!",13,10
.set0:			asciz "SET0"
.set1:			asciz "SET1"
.end:			asciz "END"
.str:			asciz "STR"
.noadr:			asciz "NOADR"
.run:			asciz "RUN"
.internal:		asciz "INTERNAL"

uinit_data: equ $

.installed:	asciz "DBITMAP command installed.",13,10
.help_noun:	asciz "HELP"
.help:		db "Install this ELD using an INSTALL keyword.",13,10
		db 13,10
		db "Run with DBITMAP [RUN] address [length] to display 8-bit-wide.",13,10
		db " The address may be INTERNAL followed by an offset to use the font.",13,10
		db "Run with DBITMAP SET0|SET1 list END to modify texts.",13,10
		db " (The default 0 text is '.' and the default 1 text is '*'.)",13,10
		db "Run with DBITMAP UNINSTALL to uninstall resident ELD.",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
hide_addresses:		resb 1
display_string:		resb 1
buffer:			resb text_buffer_length * 8 + 2
.end:

current_text_0:		resb text_buffer_length + 1
current_text_1:		resb text_buffer_length + 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

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 (transient_data_size - resident_data_size) > 0
	mov ax, transient_data_size - resident_data_size
	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_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


%include "eldlink.asm"

	align 16
code_size equ $ - code
