		page	60, 132
; ***********************************************************************
; *									*
; *	File:		profile.asm					*
; *	By:		David Rifkind					*
; *	Date:		23 Feb 91					*
; *	Model:		See "register and calling convention" below	*
; *	Version:	1.00						*
; *	Assembler:	TASM 2.0					*
; *	Environment:	MS/PC-DOS 2.00+, PC/XT/AT hardware		*
; *									*
; *	This is the resident part of the WarpSpeed profiler runtime	*
; *	module.  It gathers run-time statistics on an executable	*
; *	based on the statistics table generated by the pre-runtime	*
; *	section, and saves those statistics for later analysis.		*
; *									*
; ***********************************************************************

; $Header: d:/warpspd/RCS/profile.asm 1.3 91/03/10 21:27:22 dave Exp Locker: dave $

		locals			; Enable local labels

		include	wspfile.inc	; Structure of statistics file


;DEBUG		equ	1		; Comment out for production
TRAP8H		equ	1		; Define to fake out get/set of
					;   INT 8h vector


;
;	Register and calling convention
;
;	All functions preserve BP, SI, DI, DS, ES (!), except
;	when using them to return results.  All others may be
;	destroyed.  Parameters passed in registers when possible,
;	on the stack otherwise.  Caller must clean up the stack
;	on return.  Assumes CS=DS=SS.  Flags register string-
;	move direction bit cleared.
;


;
;	Runtime memory map
;
;	+-------------------------------+
;	|	Profiler code		| RES_TEXT
;	+-------------------------------+
;	|	Profiler data		| RES_DATA
;	+-------------------------------+
;	|	Discard segment/	| RES_DISCARD
;	|	  activation stack	|
;	+-------------------------------+
;	|	Interrupt stack		|
;	+-------------------------------+
;	|	Statistics table	|
;	+-------------------------------+
;	|	Child environment	|
;	+-------------------------------+
;	|	Child program		|
;	~				~
;


; ***************************************
; *	Manifest constants		*
; ***************************************

CR		equ	0Dh		; Carriage return
LF		equ	0Ah		; Line feed
CRLF		equ	<CR, LF>

INT3		equ	0CCh		; INT 3 breakpoint instruction

;	Reasons for disabling profiler:

XC_OFLO		equ	1		; Activation stack overflow
XC_INT3		equ	2		; Unexpected INT 3
XC_MGR		equ	3		; Incompatible overlay manager


; ***************************************
; *	Structure definitions		*
; ***************************************

;	Activation stack record

actstack_t	struc
  as_area	dw	?		; Area pointer (offset)
  as_return	dd	?		; Return address
  as_contour	dd	?		; User stack contour
  as_saveop	db	?		; Patched-out opcode
  as_flags	db	?		; Flags
  as_fcntime	db	3 dup (?)	; Function time
  as_cumtime	db	3 dup (?)	; Cumulative time
actstack_t	ends

AF_SOURCE	equ	1h		; Nested call from source location
AF_TARGET	equ	2h		; Nested call to target
AF_OVL		equ	4h		; Overlay call/return
AF_DOUBLE	equ	8h		; Return address is also call target


; ***************************************
; *	Segment definitions		*
; ***************************************

rseg		macro	name
name		segment	para public 'CODE'
name		ends
RES		group	name
		endm

		rseg	RES_TEXT	; Resident text
		rseg	RES_DATA	; Resident data
		rseg	RES_FENCE	; End of fixed part
		rseg	RES_DISCARD	; Discardable
		rseg	RES_END		; End of fixed + discardable

		purge	rseg

RES_FENCE	segment
fence		equ	$		; Gives offset of fence
RES_FENCE	ends

RES_END		segment
end_resident	equ	$		; Gives offset of end resident
RES_END		ends


; ***************************************
; *	Macros				*
; ***************************************

; ***************************************
; *	movi				*
; ***************************************
;
;	Load a register with the offset of a piece of literal
;	data in the RES_DATA segment.
;

movi		macro	reg, exp
		local	addr
RES_DATA	segment
addr		exp
RES_DATA	ends
		mov	reg, offset RES:addr
		endm


; ***********************************************************************
; *									*
; *	Permanent data segment						*
; *									*
; *	This data segment is present throughout run time.  Stuff	*
; *	(both code and data) which may be discarded at runtime goes	*
; *	in the discardable segment.					*
; *									*
; ***********************************************************************

RES_DATA	segment

wspfile		db	128 dup (?)	; Statistics file name

our_psp		dw	?		; Our PSP segment
our_cbreak	db	?		; Original DOS break flag
res_size	dw	?		; Current resident segment size
stack_top	dw	?		; Top of resident stack
act_stack	dw	?		; Activation stack base
act_size	dw	?		; Activation stack size
act_limit	dw	?		; Activation stack limit
act_sp		dw	?		; Activation stack pointer
last_seg	dw	?		; Last known segment address
prof_status	db	0		; Profiler status (0 = okay)
fcn_time	db	3 dup (0)	; Time in current function

wsphandle	dw	?		; WSP file handle
wspheader	wspheader_t <>		; WSP file header
auxheader	auxheader_t <>		; Auxiliary file header

stat_seg	dw	?		; Stats table segment

child_psp	dw	?		; Child's PSP segment
start_ax	dw	?		; AX value for program start

old_int1h	dd	?		; Old single-step vector
old_int3h	dd	?		; Old breakpoint vector
old_int8h	dd	?		; Old timer vector
IFDEF TRAP8H
old_int21h	dd	?		; Old DOS services vector
ENDIF

in_profiler	db	?		; True when profiler reentered
will_trace	db	?		; INT 3 return with trace bit set
user_sp		dw	?		; Saves user SP...
user_ss		dw	?		; ...and SS

int3_loc	dd	?		; Point to reinsert INT 3

ovltab		label	dword		; Table of overlay manager pointers:
ovl_call	dd	0		;   Call profile entry
ovl_return	dd	0		;   Return profile entry
ovl_load	dd	0		;   Overlay load entry
ovl_dest	dd	0		;   Call address
ovl_dest_id	dd	0		;   Call overlay ID
ovl_src		dd	0		;   Return address
ovl_src_id	dd	0		;   Return overlay ID
ovl_lookup	dd	0		;   Overlay lookup table
ovl_start	dd	0		;   Start of overlay pool
ovl_end		dd	0		;   End of overlay pool
ovl_in_mgr	dd	0		;   In manager flag
ovl_is_call	dd	0		;   Loading, not reloading
N_OVLTAB	equ	($-ovltab)/4

is_overlaid	db	0		; Non-zero if overlaid executable

open_msg	db	"open", 0	; Useful strings for DOS error
read_msg	db	"read", 0	;   messages
write_msg	db	"write", 0
load_msg	db	"load", 0

dos_messages	label	byte		; Table of DOS error messages:
		db	 1, "Function number invalid", 0
		db	 2, "File not found", 0
		db	 3, "Path not found", 0
		db	 4, "Too many open files", 0
		db	 5, "Access denied", 0
		db	 6, "Handle invalid", 0
		db	 7, "Memory control blocks destroyed", 0
		db	 8, "Insufficient memory", 0
		db	 9, "Memory block address invalid", 0
		db	10, "Environment invalid", 0
		db	11, "Format invalid", 0
		db	12, "Access code invalid", 0
		db	13, "Data invalid", 0
		db	14, "Unknown unit", 0
		db	15, "Disk drive invalid", 0
		db	16, "Attempted to remove current directory", 0
		db	17, "Not same device", 0
		db	18, "No more files", 0
		db	0

oflo_msg	db	CRLF
		db	"Internal error: Activation stack overflow", CRLF
		db	"Activation stack size of %u was too small.  Try again with a larger", CRLF
		db	"stack using the /a command-line switch.", CRLF, 0

int3_msg	db	CRLF
		db	"Internal error: Unexpected breakpoint", CRLF
		db	"The profiler encountered a breakpoint (INT 3) instruction at location", CRLF
		db	"%X:%X (program loaded at segment %X), and could not identify the", CRLF
		db	"source of the breakpoint.  Check your code for INT 3 instructions.", CRLF, 0

mgr_msg		db	CRLF
		db	"Incompatible overlay manager", CRLF
		db	"This program was linked with the wrong version of the WarpLink", CRLF
		db	"overlay manager.", CRLF, 0

unknown_msg	db	CRLF
		db	"Internal error: Unknown error type %u", CRLF, 0

RES_DATA	ends


; ***********************************************************************
; *									*
; *	Discardable segment						*
; *									*
; *	This segment contains code and data which may be thrown away	*
; *	once initialization is complete.  It is gone as soon as the	*
; *	activation stack is set up.  The activation stack overlays	*
; *	this segment, and must be at least as large to ensure we	*
; *	don't overwrite parts of it with the interrupt stack.		*
; *									*
; ***********************************************************************

RES_DISCARD	segment

runfile		db	128 dup (?)	; Executable file name

exec_params	equ	$		; EXEC parameters:
  ep_env	dw	0		;   Environment segment
  ep_cmd	dd	exec_cmd	;   Command line pointer
  ep_fcb1	dd	exec_fcb1	;   FCB 1 pointer
  ep_fcb2	dd	exec_fcb2	;   FCB 2 pointer
  ep_stack	dd	?		;   Initial stack pointer
  ep_entry	dd	?		;   Entry point

exec_cmd	equ	$		; EXEC command line:
  ec_len	db	?		;   Length
  ec_data	db	127 dup (?)	;   Data

exec_fcb1	db	37 dup (?)	; EXEC FCB 1
exec_fcb2	db	37 dup (?)	; EXEC FCB 2


RES_DISCARD	ends


; ***************************************
; *	Resident code segment		*
; ***************************************

RES_TEXT	segment
		assume	cs:RES, ds:RES, es:RES, ss:RES

; *******************************
; *	_profile		*
; *******************************
;
;	void far profile(char far *runfile, char far *cmdline,
;	     char far *wspfile, unsigned actstack);
;
;	Profiler entry point.  Does not return.
;

		public	_profile
_profile	proc	far

		mov	bp, sp

;	Initialization.

		mov	ax, RES		; Use our data segments
		mov	ds, ax
		mov	es, ax
		cld			; Set by C, but let's be safe

		mov	ax, 3300h	; Get DOS break flag
		int	21h
		mov	our_cbreak, dl

		mov	ah, 51h		; Get PID
		int	21h
		mov	our_psp, bx

;	Copy arguments into our local space.

		push	ds

		lds	si, [bp+4]	; Executable name, 128 bytes
		mov	di, offset RES:runfile
		mov	cx, 64
	rep	movsw

		lds	si, [bp+8]	; Command line, up to 127 bytes
		mov	di, offset RES:ec_data
		xor	cl, cl		; CL counts length of command line
@@1:		lodsb			; Get next character
		test	al, al		; Terminates at null
		jz	@@2
		stosb			; Store locally
		inc	cl		; Update count
		jmp	@@1
@@2:		mov	byte ptr es:[di], CR
					; Command line ends with CR...
		mov	es:ec_len, cl	; ...and preceded by count byte

		lds	si, [bp+12]	; Statistics file name, 128 bytes
		mov	di, offset RES:wspfile
		mov	cx, 64
	rep	movsw

		pop	ds

		mov	ax, [bp+16]	; Activation stack size
		mov	act_size, ax

;	Allocate the activation stack.  This must come before
;	the real stack to ensure that the discardable data
;	segment does not get overwritten too soon.

		mov	ax, offset RES:fence
		mov	act_stack, ax

		mov	ax, act_size	; Stack size in records
		mov	bx, type actstack_t
		mul	bx		; Stack size in bytes...
		test	dx, dx		; ...must be under 64K
		jnz	@@mem

		mov	dx, offset RES:end_resident
		sub	dx, offset RES:fence
		cmp	ax, dx		; Activation stack must be at least
		jae	@@21		;   as large as discardable segment

		mov	ax, dx		; Refigure activation stack size
		xor	dx, dx		;   from discardable segment size
		div	bx
		mov	act_size, ax
		mul	bx		; That got rid of the remainder

@@21:		add	ax, act_stack	; Stack limit...
		jc	@@mem		; ...must fit in resident group
		mov	act_limit, ax

;	Allocate stack (but don't switch stacks till a bit later).

		mov	ax, offset RES:end_resident
		add	ax, 200h	; Stack size, must be multiple of 16
		mov	stack_top, ax	; Initial top of stack
		shr	ax, 1
		shr	ax, 1
		shr	ax, 1
		shr	ax, 1		; Resident size in paragraphs
		add	ax, RES		; End resident paragraph address
		sub	ax, our_psp	; Resident length plus PSP, etc.
		mov	res_size, ax	; Actual resident size incl. PSP

;	Resize memory block.  This throws away all the C stuff,
;	never to be seen again, so make sure it's all cleaned up
;	before this point.

		push	es
		mov	es, our_psp
		mov	bx, ax
		mov	ah, 4Ah		; Reallocate memory
		int	21h
		pop	es
		jnc	@@3
@@mem:		call	mem_error

;	Switch stacks.  The stack was actually in deallocated
;	memory for a short time after the INT 21h call above.
;	Could do it the other way around if you get nervous.

@@3:		mov	ax, RES
		cli
		mov	ss, ax		; Switch to our stack
		mov	sp, stack_top
		sti

;	Load statistics file.

		call	load_wsp

;	Load executable.

		mov	ax, offset RES:child_return
					; Pass address where the child
		mov	dx, ds		;   should return in DX:AX
		call	load_exe	; Load executable
		mov	start_ax, ax	; Save initial AX value
		call	fix_addr	; Fix up addresses in stats table
		call	set_break	; Insert breakpoints in root part
					;   of child code
		call	check_ovl	; Check overlay manager pointers

;	Initialize the activation stack.  Not all of the bottom
;	stack frame gets used, but a few pieces are important.

		mov	bx, act_stack
		mov	act_sp, bx	; Activation stack grows upwards

		xor	ax, ax		; Return address can't match any
					;   real address--set it to zero
		mov	word ptr [bx].as_return+0, ax
		mov	word ptr [bx].as_return+2, ax

;	Initial dummy entry on activation stack must have actual
;	initial SS:SP as contour.  Why?  Look what happens if
;	there is a profiled label at the entry point; we'd try
;	to push a call, but there's no valid return address on
;	the user stack to set the return breakpoint.  So it ends
;	up at some random spot in memory: not good.  The "push a
;	call" logic won't do anything if the contour hasn't
;	changed (to avoid blowing activation stack over tail
;	recursion), and this takes advantage of that fact.

		mov	ax, word ptr ep_stack+0
		mov	dx, word ptr ep_stack+2
		sub	ax, 6		; Correct for local data stacked
					;   in INT 3 handler
		mov	word ptr [bx].as_contour+0, ax
		mov	word ptr [bx].as_contour+2, dx

		mov	ax, word ptr ep_entry+2
		mov	last_seg, ax	; Record initial code segment

;	Let 'em know what's going on.

		mov	bx, 2
		movi	dx, <db "Starting execution", CRLF, 0>
		call	writestr

;	Set up profiler interrupts.

		mov	in_profiler, 1	; So timer won't really start yet
		call	set_vectors	; Catch timer, step, breakpoint

;	Prepare to run child program.

		inc	auxheader.ah_nruns
					; Records number of times run

		mov	ah, 50h		; Switch to child's context
		mov	bx, child_psp
		int	21h

		mov	ax, 3301h	; Reset DOS break flag (was changed
		mov	dl, our_cbreak	;   by load_exe)
		int	21h

;	Nasty case here.  If some horrible error happened after
;	we loaded the child program but before we start, we
;	couldn't just EXIT because that would leave the child
;	still in memory.  It has a different PID, so there have
;	to be two EXIT calls to clean everything up, which is
;	just what happens now.  If we EXIT now, in the child's
;	context, it's the child and NOT the profiler that gets
;	terminated.  Execution resumes at child_return.

		cmp	prof_status, 0	; Something bad happened...
		jz	@@3a

		mov	ax, 4CFFh	; Terminate child
		int	21h

@@3a:		cli
		mov	in_profiler, 0	; Start attributing times to child
		mov	ss, word ptr ep_stack+2 ; Switch to child's stack
		mov	sp, word ptr ep_stack+0
		pushf
		pop	ax		; Grab the flags register...
		or	ax, 200h	; ...enable interrupts...
		pushf			; ...and stuff it back for IRET
		push	word ptr cs:ep_entry+2
		push	word ptr cs:ep_entry+0
		mov	ax, child_psp
		mov	ds, ax		; Initialize DS
		mov	es, ax		; Initialize ES just for jollies
		mov	ax, cs:start_ax	; Returned by load_exe
IFDEF DEBUG
		call	debug_out
ENDIF
		iret			; This starts the child

;	We're back!  The child program has terminated, and it's
;	time to clean up.

child_return:	mov	cs:in_profiler, 1

IFDEF DEBUG
		call	debug_in
ENDIF

		mov	ax, RES		; Switch back to our data segment
		mov	ds, ax
		mov	es, ax
		cli
		mov	ss, ax		; Switch back to our stack
		mov	sp, stack_top
		sti
		cld			; Required everywhere in module

		mov	ax, 3301h	; Set DOS break flag
		mov	dl, our_cbreak
		int	21h

		call	restore_vectors	; Put back timer, step, break

		mov	bl, prof_status	; Did the profiler kick out w/error?
		test	bl, bl
		jnz	@@4

;	Normal termination of child.

		mov	ah, 4Dh		; Get child exit status
		int	21h
		push	ax
		mov	bx, 2		; stderr
		movi	si, <db CRLF, "Program terminated, exit code = %u", CRLF, 0>
		call	fprintf
		add	sp, 2

		mov	al, 0		; Easy way to clean off activation
		call	forget_it	;   stack

		call	save_wsp	; Save results

		mov	ax, 4C00h	; We're done
		int	21h

;	Abnormal termination.  Something bad happened to the
;	profiler, and we didn't get valid results.

@@4:		cmp	bl, XC_OFLO
		jne	@@5

;	Activation stack overflowed.

		push	act_size	; See format string
		mov	bx, 2		; stderr
		mov	si, offset RES:oflo_msg
		call	fprintf
		add	sp, 2

		mov	ax, 4C01h	; Abnormal termination
		int	21h

@@5:		cmp	bl, XC_INT3
		jne	@@6

;	Unexpected breakpoint

		mov	ax, child_psp
		add	ax, 10h		; Program load point
		push	ax
		push	word ptr int3_loc+0 ; Unexpected breakpoint
		push	word ptr int3_loc+2 ;   address
		mov	bx, 2		; stderr
		mov	si, offset RES:int3_msg
		call	fprintf
		add	sp, 6

		mov	ax, 4C01h	; Abnormal termination
		int	21h

@@6:		cmp	bl, XC_MGR
		jne	@@7

;	Got linked with wrong overlay manager.

		mov	bx, 2
		mov	si, offset RES:mgr_msg
		call	fprintf

		mov	ax, 4C01h	; Abnormal termination
		int	21h

;	Hey!  What happened?  Unknown error code.

@@7:		xor	bh, bh
		push	bx		; Error code number
		mov	bx, 2		; stderr
		mov	si, offset RES:unknown_msg
		call	fprintf
		add	sp, 2

		mov	ax, 4C01h	; Very abnormal termination
		int	21h

_profile	endp


; *******************************
; *	load_wsp		*
; *******************************
;
;	Load statistics file.  The file is left open during the
;	run to make sure we can write it again on exit.  Other-
;	wise, the program might change drives or directories and
;	we wouldn't be able to find the thing.
;

RES_DISCARD	segment			; Discardable code
load_wsp	proc	near

;	Open, read file header.

		mov	ax, 3D02h	; Open file read/write
		mov	dx, offset RES:wspfile
		int	21h
		mov	dx, offset RES:open_msg
		jc	@@dos		; Couldn't open
		mov	wsphandle, ax

		mov	bx, ax		; File handle
		mov	ah, 3Fh		; Read file
		mov	cx, type wspheader_t
		mov	dx, offset RES:wspheader
		int	21h
		mov	dx, offset RES:read_msg
		jc	@@dos		; Couldn't read

		cmp	ax, type wspheader_t
		jb	@@format	; End of file reading header

;	Check header format.  Look for signature, and check
;	version numbers.

		cmp	word ptr wspheader.wh_sig+0, 5357h
		jne	@@format	; Bad signature
		cmp	word ptr wspheader.wh_sig+2, 1A50h
		jne	@@format	; Bad signature

		cmp	wspheader.wh_filever, PROFVER
		jb	@@version	; Version mismatch
		cmp	wspheader.wh_profver, FILEVER
		jae	@@1

;	Version number error.

@@version:	mov	ax, offset RES:wspfile
		push	ax
		mov	bx, 2		; stderr
		movi	si, <db CRLF, "%s: wrong file version", CRLF, 0>
		call	fprintf
		add	sp, 2

		mov	ax, 4C01h	; Abnormal termination
		int	21h

;	File format error.

@@format:	mov	ax, offset RES:wspfile
		push	ax
		mov	bx, 2		; stderr
		movi	si, <db CRLF, "%s: invalid format", CRLF, 0>
		call	fprintf
		add	sp, 2

		mov	ax, 4C01h	; Abnormal termination
		int	21h

;	DOS error.

@@dos:		mov	bx, offset RES:wspfile
		call	dos_error	; Does not return

;	Read auxiliary header.

@@1:		mov	ah, 3Fh		; Read file
		mov	bx, wsphandle
		mov	cx, type auxheader_t
		mov	dx, offset RES:auxheader
		int	21h
		mov	dx, offset RES:read_msg
		jc	@@dos		; Couldn't read

		cmp	ax, type auxheader_t
@@3:		jb	@@format	; End of file reading header

;	Allocate and read stats table.

		mov	ax, res_size	; Find paragraph address of end of
		add	ax, our_psp	;   current resident part
		mov	stat_seg, ax	; That's where stats table starts

		mov	bx, word ptr wspheader.wh_statlen
		add	bx, 15		; Round up to paragraph boundary
		rcr	bx, 1		; Rotate first in case add carried
		shr	bx, 1
		shr	bx, 1
		shr	bx, 1
		add	bx, res_size	; New resident size...
		jc	@@mem		; ...should not have overflowed
		mov	res_size, bx

		push	es
		mov	ah, 4Ah		; Reallocate memory block to include
		mov	es, our_psp	;   stats table
		int	21h
		pop	es
		jc	@@mem		; Allocation failed

		mov	ah, 3Fh		; Read stats header and table
		mov	bx, wsphandle
		mov	cx, word ptr wspheader.wh_statlen
		push	ds
		mov	dx, stat_seg	; Table goes at stat_seg:0
		mov	ds, dx
		xor	dx, dx
		int	21h
		pop	ds
		mov	dx, offset RES:read_msg
		jc	@@dos		; Couldn't read

		cmp	ax, word ptr wspheader.wh_statlen
		jb	@@3		; End of file reading table

		ret

;	Out of memory.

@@mem:		call	mem_error	; Does not return

load_wsp	endp
RES_DISCARD	ends


; *******************************
; *	save_wsp		*
; *******************************
;
;	Write out the changed WSP file headers and statistics
;	tables.
;

save_wsp	proc	near

		mov	bx, 2		; stderr
		movi	dx, <db "Writing execution statistics", CRLF, 0>
		call	writestr

		mov	ax, 4200h	; Seek absolute...
		mov	bx, wsphandle
		xor	cx, cx		; ...to beginning of file
		xor	dx, dx
		int	21h		; Ignore return code (any error
					;   will show up again later)

;	Write headers.  Note we assume that will never run out
;	of disk space writing, because file was preallocated.

		mov	ah, 40h		; Write file header
		mov	bx, wsphandle
		mov	cx, type wspheader_t
		mov	dx, offset RES:wspheader
		int	21h
		mov	dx, offset RES:write_msg
		jc	@@dos		; Couldn't write

		mov	ah, 40h		; Write auxiliary header
		mov	bx, wsphandle
		mov	cx, type auxheader_t
		mov	dx, offset RES:auxheader
		int	21h
		mov	dx, offset RES:write_msg
		jc	@@dos		; Couldn't write

;	Save statistics table.

		mov	ah, 40h		; Write stats table
		mov	bx, wsphandle
		mov	cx, word ptr wspheader.wh_statlen
		push	ds
		mov	dx, stat_seg	; Table is at stat_seg:0
		mov	ds, dx
		xor	dx, dx
		int	21h
		pop	ds
		mov	dx, offset RES:write_msg
		jc	@@dos		; Couldn't write

;	Close file.

		mov	ah, 3Eh		; Close file
		mov	bx, wsphandle
		int	21h
		mov	dx, offset RES:write_msg
		jc	@@dos		; Eurgh - problem flushing buffers

		ret

;	DOS error.

@@dos:		mov	bx, offset RES:auxheader
		call	dos_error	; Does not return

save_wsp	endp


; *******************************
; *	load_exe		*
; *******************************
;
;	Load executable file.  This sets child_psp but leaves
;	our process in control.  It leaves the DTA set to the
;	child's PSP, and leaves the DOS break flag off.
;
;	Little-known DOS facts #753: The only register (other
;	than segments and stack) with a guaranteed value on
;	program entry is AX.  AH and AL contain flags telling
;	whether the drive specifiers in the two default FCBs are
;	for valid drives.  That's what gets returned in AX.
;
;	Entry:	DX:AX	Child's termination address
;	Exit:	AX	Value for AX on program entry
;

RES_DISCARD	segment			; Discardable code
load_exe	proc	near

		push	si		; Save registers
		push	di
		push	es

		push	dx		; Return address, for later use
		push	ax

;	Set up file control blocks for exec parameter list.
;	Save "valid disk unit" flags for return.

		mov	ax, 2901h	; Parse filename, ignore separators
		mov	si, offset RES:ec_data
		mov	di, offset RES:exec_fcb1
		int	21h
		sar	al, 1		; 0 or 0FFh
		mov	bl, al

		mov	ax, 2901h	; The same again
		mov	di, offset RES:exec_fcb2
		int	21h
		sar	al, 1		; 0 or 0FFh
		mov	ah, al
		mov	al, bl
		push	ax		; Save for later

;	Load but do not execute.  This is an undocumented DOS
;	call.  Sorry, that's just the way it is.  Under DOS 2.x
;	this can destroy all registers, including SS:SP.

		push	bp		; Save registers
		push	si
		push	di
		push	ds
		push	es

		mov	user_sp, sp	; Save stack
		mov	user_ss, ss

		mov	ax, 4B01h
		mov	dx, offset RES:runfile
		mov	bx, offset RES:exec_params
		int	21h

		cli			; Restore stack
		mov	ss, cs:user_ss
		mov	sp, cs:user_sp
		sti

		pop	es		; Restore registers
		pop	ds
		pop	di
		pop	si
		pop	bp

		jc	@@3		; LOAD failed

;	From now until the child terminates, it would be a VERY
;	bad idea to allow Ctrl-C to terminate the program.  The
;	original break flag has already been saved, so we just
;	turn it off.

		mov	ax, 3301h	; Set DOS break flag
		xor	dl, dl
		int	21h

;	This is not an obvious place to do it, but the child has
;	inherited a copy of our WSP file handle, and we don't
;	want that, so let's close it.

		mov	ah, 3Eh		; Close file
		mov	bx, wsphandle
		int	21h

;	Currently we are in the child's DOS context.  Save that
;	context and switch back to ours.

		mov	ah, 51h		; Get PID
		int	21h
		mov	child_psp, bx

		mov	ah, 50h		; Set PID
		mov	bx, our_psp
		int	21h

		pop	ax		; Set by FCB parsing

		mov	es, child_psp	; Termination address goes at
		pop	es:[0Ah]	;   offset 0Ah in PSP.  Ignore
		pop	es:[0Ch]	;   everything anyone ever told you
					;   about INT 22h - it's a lie.

		pop	es		; Saved on entry
		pop	di
		pop	si
		ret

;	Error loading program.

@@3:		mov	bx, offset RES:runfile
		mov	dx, offset RES:load_msg
		call	dos_error	; Does not return

load_exe	endp
RES_DISCARD	ends


; *******************************
; *	fix_addr		*
; *******************************
;
;	Fix up addresses in statistics table to reflect the
;	program's load point.  Overlaid symbols do not get
;	changed.
;

RES_DISCARD	segment			; Discardable code
fix_addr	proc	near

		push	es		; Save register

		mov	es, stat_seg	; Stats table referenced by ES
		mov	ax, child_psp	; Child PSP address plus 10h is
		add	ax, 10h		;   child code address

;	Fancy footwork in case we're running second or later
;	time with same WSP file.  Address have already been
;	fixed up once, and just need to be corrected for new
;	load address.

		mov	bx, es:[0h].sh_base
		mov	es:[0h].sh_base, ax
		sub	ax, bx		; Difference in base addresses

		mov	cx, es:[0h].sh_nsyms
		jcxz	@@3
		mov	bx, es:[0h].sh_symptr ; ES:BX points into stats table
@@2:		add	word ptr es:[bx].se_addr+2, ax
		add	bx, type statentry_t
		loop	@@2
@@3:

		pop	es		; Saved on entry
		ret

fix_addr	endp
RES_DISCARD	ends


; *******************************
; *	set_break		*
; *******************************
;
;	Set breakpoints at all resident function entry points.
;	Save the original opcodes.  Also fill in overlay pointer
;	table with overlay manager magic addresses.
;

RES_DISCARD	segment			; Discardable code
set_break	proc	near

		push	si		; Save registers
		push	ds
		push	es

		mov	ds, stat_seg	; Stats table referenced by DS
		mov	cx, ds:[0h].sh_nsyms
		jcxz	@@4
		mov	si, ds:[0h].sh_symptr ; DS:SI points into stats table

@@1:		test	[si].se_flags, SF_DATA
		jnz	@@2		; Data addresses don't get breakpoints
		les	bx, [si].se_addr
		mov	al, es:[bx]	; Original opcode at this address
		mov	[si].se_saveop, al
		mov	byte ptr es:[bx], INT3 ; Set breakpoint

@@2:		mov	bl, [si].se_flags
		test	bl, SF_MAGIC
		jz	@@3

;	Found overlay manager magic address, so this must be an
;	overlaid executable.  Store address in pointer table for
;	later use.

		mov	cs:is_overlaid, 1
		and	bl, SF_MAGNO	; Low bits of flags are symbol number
		cmp	bl, N_OVLTAB	; Watch out for table overrun
		jae	@@3
		xor	bh, bh
		shl	bx, 1		; Four bytes per table entry
		shl	bx, 1
		mov	ax, word ptr [si].se_addr+0
		mov	dx, word ptr [si].se_addr+2
		mov	word ptr cs:ovltab[bx+0], ax
		mov	word ptr cs:ovltab[bx+2], dx

@@3:		add	si, type statentry_t
		loop	@@1
@@4:

		pop	es		; Saved on entry
		pop	ds
		pop	si
		ret

set_break	endp
RES_DISCARD	ends


; *******************************
; *	del_break		*
; *******************************
;
;	Delete all breakpoints from user code.  Called only when
;	something horrible happens, forcing the profiler to bail
;	out.
;

del_break	proc	near

		push	si		; Save registers
		push	ds
		push	es

		mov	ds, stat_seg	; Stats table referenced by DS
		mov	cx, ds:[0h].sh_nsyms
		jcxz	@@3
		mov	si, ds:[0h].sh_symptr ; DS:SI points into stats table
@@1:		test	[si].se_flags, SF_DATA
		jnz	@@2		; Data address have no breakpoints
		les	bx, [si].se_addr
		mov	al, [si].se_saveop
		mov	byte ptr es:[bx], al ; Restore original opcode
@@2:		add	si, type statentry_t
		loop	@@1
@@3:

		pop	es		; Saved on entry
		pop	ds
		pop	si
		ret

del_break	endp


; *******************************
; *	check_ovl		*
; *******************************
;
;	Check that program was linked with correct overlay
;	manager, i.e., no overlay manager magic symbols missing
;	from link map.  Any missing mean we can't run safely.
;

RES_DISCARD	segment
check_ovl	proc	near

		cmp	is_overlaid, 0
		jz	@@3		; Not overlaid, stop worrying

		mov	bx, offset RES:ovltab
		mov	cx, N_OVLTAB
@@1:		mov	ax, [bx+0]	; Zero entry in pointer table?
		or	ax, [bx+2]
		jz	@@2		; Zero entry means missing symbol
		add	bx, 4
		loop	@@1
		jmp	short @@3

;	Missing entry.  Set profiler error code, but since the
;	child has already been loaded, we can't terminate just
;	yet.  Code in main routine handles this.

@@2:		mov	prof_status, XC_MGR

@@3:		ret

check_ovl	endp
RES_DISCARD	ends


; *******************************
; *	set_vectors		*
; *******************************
;
;	Initialize profiler interrupt vectors.  Note can't be
;	discardable because we've already set up the activation
;	stack.  Actually, it COULD be discardable because only
;	the first act_stack entry is set, but I'm timid and
;	think it's cleaner not to mess around.
;

set_vectors	proc	near

		push	es		; Save register

;	Save original vectors.

IFDEF DEBUG
		xor	ax, ax		; Debugging, we don't trust INT 21h
		mov	es, ax		;   AH=35h
		mov	ax, es:[4h]	; INT 1 vector low
		mov	word ptr old_int1h+0, ax
		mov	ax, es:[6h]	; INT 1 vector high
		mov	word ptr old_int1h+2, ax
ELSE
		mov	ax, 3501h	; Get single-step vector
		int	21h
		mov	word ptr old_int1h+0, bx
		mov	word ptr old_int1h+2, es
ENDIF

IFDEF DEBUG
		xor	ax, ax
		mov	es, ax
		mov	ax, es:[0Ch]	; INT 3 vector low
		mov	word ptr old_int3h+0, ax
		mov	ax, es:[0Eh]	; INT 3 vector high
		mov	word ptr old_int3h+2, ax
ELSE
		mov	ax, 3503h	; Get breakpoint vector
		int	21h
		mov	word ptr old_int3h+0, bx
		mov	word ptr old_int3h+2, es
ENDIF

;	About TRAP8H.  Some systems lie about hardware IRQ
;	vector addresses, which makes it impossible to know
;	when executing in DOS/BIOS.  Going around DOS is
;	dirty, but the only way to be sure.  That means we also
;	have to supply a replacement handler for INT 21h AX=3508h
;	or AX=2508h.

IFDEF TRAP8H
		xor	ax, ax
		mov	es, ax
		mov	ax, es:[20h]	; INT 8 vector low
		mov	word ptr old_int8h+0, ax
		mov	ax, es:[22h]	; INT 8 vector high
		mov	word ptr old_int8h+2, ax
ELSE
		mov	ax, 3508h	; Get timer tick vector
		int	21h
		mov	word ptr old_int8h+0, bx
		mov	word ptr old_int8h+2, es
ENDIF

IFDEF TRAP8H
		mov	ax, 3521h	; Get DOS services vector
		int	21h
		mov	word ptr old_int21h+0, bx
		mov	word ptr old_int21h+2, es
ENDIF

;	Set new vectors.

		mov	ax, 2501h	; Set single-step vector
		mov	dx, offset RES:int1h
		int	21h

		mov	ax, 2503h	; Set breakpoint vector
		mov	dx, offset RES:int3h
		int	21h

IFDEF TRAP8H
		xor	ax, ax
		mov	es, ax
		cli
		mov	word ptr es:[20h], offset RES:int8h
		mov	word ptr es:[22h], cs
		sti
ELSE
		mov	ax, 2508h	; Set timer tick vector
		mov	dx, offset RES:int8h
		int	21h
ENDIF

IFDEF TRAP8H
		mov	ax, 2521h	; Set DOS services vector
		mov	dx, offset RES:int21h
		int	21h
ENDIF

		pop	es		; Saved on entry
		ret

set_vectors	endp


; *******************************
; *	restore_vectors		*
; *******************************
;
;	Restore original interrupt vectors.
;

restore_vectors	proc	near

		push	ds		; Save register

IFDEF TRAP8H
		mov	ax, 2521h	; Set DOS services vector
		mov	dx, word ptr cs:old_int21h+0
		mov	ds, word ptr cs:old_int21h+2
		int	21h
ENDIF

IFDEF TRAP8H
		push	es
		xor	ax, ax
		mov	es, ax
		mov	ax, word ptr cs:old_int8h+0
		mov	es:[20h], ax	; INT 8 vector low
		mov	ax, word ptr cs:old_int8h+2
		mov	es:[22h], ax	; INT 8 vector high
		pop	es
ELSE
		mov	ax, 2508h	; Set timer tick vector
		mov	dx, word ptr cs:old_int8h+0
		mov	ds, word ptr cs:old_int8h+2
		int	21h
ENDIF

		mov	ax, 2503h	; Set breakpoint vector
		mov	dx, word ptr cs:old_int3h+0
		mov	ds, word ptr cs:old_int3h+2
		int	21h

		mov	ax, 2501h	; Set single-step vector
		mov	dx, word ptr cs:old_int1h+0
		mov	ds, word ptr cs:old_int1h+2
		int	21h

		pop	ds		; Saved on entry
		ret

restore_vectors	endp


; *******************************
; *	int1h			*
; *******************************
;
;	Single-step trap handler.  We're here because a break-
;	point has been temporarily removed so that we can step
;	over it, but needs to be reinserted after executing one
;	instruction.
;
;	With this routine being so short, you probably wonder
;	why we go to all the trouble of enabling interrupts for
;	such a brief period.  We want to reduce the amount of
;	bias introduced in timings by giving timer ticks some
;	chance of coming through while we're in here.
;

int1h		proc	far

IFDEF DEBUG
		call	debug_in
ENDIF

		mov	cs:in_profiler, 1 ; Attribute time to profiler
		sti

		push	bp
		mov	bp, sp		; For indexing user stack
		push	bx		; Save registers
		push	ds

;	Insert the breakpoint.

		lds	bx, cs:int3_loc	; Was set by INT 3 handler
		mov	byte ptr ds:[bx], INT3

;	Turn off single-step mode on return.

		and	word ptr [bp+6], not 100h ; Clear single-step bit

		pop	ds		; Saved on entry
		pop	bx
		pop	bp

		cli
		mov	cs:in_profiler, 0 ; Back to user code

IFDEF DEBUG
		call	debug_out
ENDIF
		iret

int1h		endp


; *******************************
; *	int3h			*
; *******************************
;
;	Breakpoint handler.  We get here from an INT 3 in the
;	user code, which may be one of several things: function
;	entry point, trap inserted at call return, or internal
;	breakpoint within overlay manager.
;

int3h		proc	far

IFDEF DEBUG
		call	debug_in
ENDIF

;	Context switch.  Set up stacks, segments, etc. for
;	profiler internals.

		mov	cs:in_profiler, 1 ; Attribute time to profiler
		mov	cs:will_trace, 0  ; Assume trace bit won't be set
					  ;   on exit

		push	ax		; Save AX on user stack
		mov	cs:user_sp, sp	; Save user stack pointer
		mov	cs:user_ss, ss

		mov	ax, RES		; Switch to profiler stack
		mov	ss, ax
		mov	sp, cs:stack_top

		sti

		push	bx		; Save everything (AX already saved)
		push	cx
		push	dx
		push	bp
		push	si
		push	di
		push	ds
		push	es

		mov	ds, ax		; AX still contains RES segment
		cld			; Required internally

;	Get breakpoint address.  The stacked IP value is for the
;	instruction following the breakpoint, so we decrement.

		les	bx, dword ptr user_sp
		mov	ax, es:[bx+2]
		mov	dx, es:[bx+4]
		dec	ax

;	CX:BX will hold user stack pointer, after adjustment for
;	AX saved at entry to this handler.

		mov	bx, user_sp
		add	bx, 2
		mov	cx, user_ss

;	Check for overlay manager call.  Throughout the next
;	section of code, until we've determined the breakpoint
;	source, do not destroy DX:AX or CX:BX.

		cmp	ax, word ptr ovl_call+0
		jne	@@1
		cmp	dx, word ptr ovl_call+2
		jne	@@1

;	*** Vectored Call ***

		call	push_ovl_call	; Handle vectored call
		jmp	@@7


;	Check for overlay manager return.

@@1:		cmp	ax, word ptr ovl_return+0
		jne	@@2
		cmp	dx, word ptr ovl_return+2
		jne	@@2

;	*** Vectored Return ***

		call	pop_ovl_return	; Handle vectored return
		jmp	@@7


;	Check for overlay load.

@@2:		cmp	ax, word ptr ovl_load+0
		jne	@@3
		cmp	dx, word ptr ovl_load+2
		jne	@@3

;	*** Load or Reload ***

		call	track_loads	; Handle load/reload
		jmp	@@7


;	Whatever this breakpoint is, it's not overlay manager
;	internal, which means we'll probably have to reexecute
;	after patching out the breakpoint.  So the decremented
;	IP value needs to go back on the stack.

@@3:		mov	es, cx
		mov	es:[bx], ax

		mov	word ptr int3_loc+0, ax
		mov	word ptr int3_loc+2, dx

;	Check for return on activation stack.  Registers lost!

		call	is_return
		jc	@@5

;	*** Normal Return ***

		mov	ax, word ptr [bx].as_return+2
		mov	last_seg, ax	; Keep track of current segment

		test	[bx].as_flags, AF_SOURCE or AF_DOUBLE
		jz	@@4		; Not nested or double-entry

;	Nested return or double entry.  Since act_unwind is not
;	going to patch in the original opcode in these cases, we
;	have to do it ourselves.

		mov	al, [bx].as_saveop ; Original opcode
		les	di, [bx].as_return ; Address of INT 3
		mov	es:[di], al

;	But!  The reason act_unwind didn't patch the breakpoint
;	out is that it belongs there; we just have to step over
;	it.  So set the trace bit in the stacked flags word.

		les	di, dword ptr user_sp
		or	word ptr es:[di+6], 100h ; Set trace bit
		inc	will_trace	; Yes, we're tracing

;	is_return returned the activation stack pointer for the
;	function now returning.  We want to unwind back to the
;	record previous to that one.

@@4:		mov	ax, bx
		sub	ax, type actstack_t
		call	act_unwind

		jmp	short @@7


;	Not a return.  See if it's a call.

@@5:		mov	ax, word ptr int3_loc+0
		mov	dx, word ptr int3_loc+2
		call	find_addr
		jc	@@6

;	*** Normal Call ***

		mov	al, es:[bx].se_saveop ; Original opcode
		les	di, es:[bx].se_addr   ; Breakpoint address
		mov	es:[di], al

		les	di, dword ptr user_sp
		or	word ptr es:[di+6], 100h ; Set trace bit
		inc	will_trace

;	Push a new activation stack frame.  Again, stack is
;	adjusted for AX saved at top of this routine.

		mov	ax, user_sp
		add	ax, 2
		mov	dx, user_ss
		call	push_call

		jmp	short @@7


;	Don't know what it is, but we still need to patch it
;	out.  This happens when a single indirect call is used
;	to make calls to both profiled and unprofiled routines.
;	On return from an unprofiled call, there's no activation
;	record for that call, but there's still a breakpoint to
;	be stepped over.

@@6:		les	bx, dword ptr user_sp
		mov	ax, es:[bx+2]
		mov	dx, es:[bx+4]
		call	need_patch
		jc	@@8

;	*** Spurious Breakpoint ***

		mov	al, [bx].as_saveop ; Saved opcode
		les	bx, [bx].as_return ; Breakpoint address
		mov	es:[bx], al
		mov	last_seg, es	; For far/near determination

		les	bx, dword ptr user_sp
		or	word ptr es:[bx+6], 100h ; Set trace bit
		inc	will_trace


;	Breakpoint handler done.

@@7:		pop	es		; Saved on entry
		pop	ds
		pop	di
		pop	si
		pop	bp
		pop	dx
		pop	cx
		pop	bx

		cli
		mov	ss, cs:user_ss	; Switch back to user stack
		mov	sp, cs:user_sp

;	If we're stepping over an opcode to patch the breakpoint
;	back in on the next instruction, we don't clear the
;	in_profiler semaphore.  This is only fair, as in most
;	cases more time will be spent on refetching instructions
;	and taking the single-step trap than on executing the
;	instruction.  So times end up being more accurate this
;	way.

		mov	al, cs:will_trace
		mov	cs:in_profiler, al
		pop	ax		; Saved on entry

IFDEF DEBUG
		call	debug_out
ENDIF
		iret


;	Aargh!  Got a breakpoint and can't identify it.  The
;	profiler will now crash and burn for your amusement.

@@8:		mov	al, XC_INT3	; Unexpected INT 3 error
		call	forget_it	; Disable profiler

;	Remember, we're in the child program's context, so this
;	EXIT call will take us back to child_return in the main
;	function.

		mov	ax, 4CFFh
		int	21h

int3h		endp


; *******************************
; *	int8h			*
; *******************************
;
;	Timer tick interrupt handler.
;

int8h		proc	far

		pushf
		call	cs:old_int8h	; Chain to old handler
		cli

;	If profiler has died, just forget it.

		cmp	cs:prof_status, 0
		jz	@@0
		iret
@@0:

;	Increment total run time.

		add	word ptr cs:auxheader.ah_elapsed+0, 1
		adc	word ptr cs:auxheader.ah_elapsed+2, 0

		cmp	cs:in_profiler, 0
		jz	@@1

;	In profiler, just record lost time.

		add	word ptr cs:auxheader.ah_proftime+0, 1
		adc	word ptr cs:auxheader.ah_proftime+2, 0

		iret

;	Not us.  We're all EOIed and stuff, so we can just
;	switch into the profiler's context.

@@1:		mov	cs:in_profiler, 1

		push	ax		; Need one free register
		mov	cs:user_sp, sp
		mov	cs:user_ss, ss

		mov	ax, RES
		mov	ss, ax		; Interrupts still disabled
		mov	sp, cs:stack_top

		sti

IFDEF DEBUG
		call	debug_in
ENDIF

		push	bx		; Save the world
		push	cx
		push	dx
;;;;		push	bp \
;;;;		push	si  > NOT USED
;;;;		push	di /
		push	ds
		push	es

		mov	ds, ax
		cld

;	Find out where user code was executing.  Was it in the
;	main allocated memory block?

		les	bx, dword ptr user_sp
		mov	ax, es:[bx+4]	; Saved CS
		mov	dx, es:[bx+2]	; Saved IP
		mov	cl, 4
		shr	dx, cl
		add	ax, dx		; Canonical CS

		mov	bx, child_psp
		cmp	ax, bx
		jb	@@2		; Below start of child code
		dec	bx		; Child's MCB segment
		mov	es, bx
		add	bx, es:[3h]	; Last paragraph of child's block
		cmp	ax, bx
		jbe	@@3

;	Well, was it in the overlay pool?

		cmp	is_overlaid, 0
		jz	@@2
		les	bx, ovl_start	; Start-of-pool pointer
		cmp	ax, es:[bx]
		jb	@@2
		les	bx, ovl_end	; End-of-pool pointer
		cmp	ax, es:[bx]
		jb	@@3

;	Child was running in DOS or BIOS.  (That just means it
;	was running anywhere except in its own code.  This is
;	not very reliable.)

@@2:		add	word ptr auxheader.ah_dostime+0, 1
		adc	word ptr auxheader.ah_dostime+2, 0

;	Increment total run time.

@@3:		add	word ptr auxheader.ah_runtime+0, 1
		adc	word ptr auxheader.ah_runtime+2, 0

;	Was the overlay manager working?

		cmp	is_overlaid, 0
		jz	@@4
		les	bx, ovl_in_mgr	; Overlay manager semaphore pointer
		cmp	byte ptr es:[bx], 0
		jz	@@4

		add	word ptr auxheader.ah_omtime+0, 1
		adc	word ptr auxheader.ah_omtime+2, 0

		jmp	short @@5

;	Running user code.  Increment time in function.

@@4:		add	word ptr fcn_time+0, 1
		adc	byte ptr fcn_time+2, 0

;	Switch back to user context and return.

@@5:		pop	es		; Saved on entry
		pop	ds
;;;;		pop	di \
;;;;		pop	si  > NOT USED
;;;;		pop	bp /
		pop	dx
		pop	cx
		pop	bx

IFDEF DEBUG
		call	debug_out
ENDIF

		cli

		mov	ss, cs:user_ss	; Back to user stack
		mov	sp, cs:user_sp
		pop	ax

		mov	cs:in_profiler, 0

		iret

int8h		endp


IFDEF TRAP8H

; *******************************
; *	int21h			*
; *******************************
;
;	Traps the INT 21h DOS services vector.  We want to fake
;	out attempts to get or set the INT 8h vector using DOS
;	services 35h or 25h.
;

int21h		proc	far

		cmp	ax, 3508h
		jne	@@1

;	AX=3508h: get INT 8h vector.

		les	bx, cs:old_int8h
		clc
		ret	2

@@1:		cmp	ax, 2508h
		jne	@@2

;	AX=2508h: set INT 8h vector.

		cli
		mov	word ptr cs:old_int8h+0, dx
		mov	word ptr cs:old_int8h+2, ds
		sti

		clc
		ret	2

@@2:		jmp	cs:old_int21h

int21h		endp

ENDIF


IFDEF DEBUG

; *******************************
; *	debug_in		*
; *******************************
;
;	For debugging.  Entering the profiler, have to restore
;	the original INT 1 and INT 3 vectors so the debugger can
;	work.  Modifies no registers.
;

debug_in	proc	near

		push	ax		; Save registers
		push	ds

		xor	ax, ax		; DS points to vectors on page 0
		mov	ds, ax

		mov	ax, word ptr cs:old_int1h+0
		mov	ds:[04h], ax	; INT 1 vector low
		mov	ax, word ptr cs:old_int1h+2
		mov	ds:[06h], ax	; INT 1 vector high

		mov	ax, word ptr cs:old_int3h+0
		mov	ds:[0Ch], ax	; INT 3 vector low
		mov	ax, word ptr cs:old_int3h+2
		mov	ds:[0Eh], ax	; INT 3 vector high

		pop	ds		; Saved on entry
		pop	ax
		ret

debug_in	endp


; *******************************
; *	debug_out		*
; *******************************
;
;	For debugging.  Leaving a profiler interrupt handler,
;	set INT 1 and INT 3 back to point to our handlers.
;	Modifies no registers.
;

debug_out	proc	near

		push	ax		; Save registers
		push	ds

		xor	ax, ax		; DS points to vectors on page 0
		mov	ds, ax

		mov	word ptr ds:[04h], offset RES:int1h
		mov	word ptr ds:[06h], cs

		mov	word ptr ds:[0Ch], offset RES:int3h
		mov	word ptr ds:[0Eh], cs

		pop	ds		; Saved on entry
		pop	ax
		ret

debug_out	endp

ENDIF


; *******************************
; *	is_return		*
; *******************************
;
;	Determine whether a given address and stack pointer
;	correspond to a return from a call on the activation
;	stack.
;
;	Entry:	DX:AX	Breakpoint address
;		CX:BX	Stack pointer
;	Exit:	CF	Clear if match found
;		BX	Activation stack pointer for match
;

is_return	proc	near

		push	si		; Save register

;	Run down the activation stack looking for a record that
;	matches the current address and stack.

		mov	si, act_sp

@@1:		cmp	si, act_stack
		jbe	@@3		; Reached bottom of stack

		cmp	cx, word ptr [si].as_contour+2
		jne	@@2		; Different stack segment
		cmp	bx, word ptr [si].as_contour+0
		jbe	@@3		; Higher (less full) stack pointer
					;   means we can stop looking

		test	[si].as_flags, AF_OVL
		jnz	@@2		; Ignore overlay calls

		cmp	ax, word ptr [si].as_return+0
		jne	@@2		; Return address doesn't match
		cmp	dx, word ptr [si].as_return+2
		je	@@4		; Success - return address matches
					;   (leaves carry clear)

@@2:		sub	si, type actstack_t
		jmp	@@1		; Try next record

@@3:		stc			; Failed; set carry
@@4:		mov	bx, si		; Return pointer in BX
		pop	si		; Saved on entry
		ret

is_return	endp


; *******************************
; *	pop_ovl_return		*
; *******************************
;
;	Pop the topmost overlay call off the activation stack.
;	We don't have to do all that clever stuff about checking
;	for matching activation records, because the overlay
;	manager is guaranteed to crash and burn if you start
;	violating stack protocol on it.
;
;	Entry:	CX:BX	Stack pointer
;

pop_ovl_return	proc

		push	es		; Save register

		mov	ax, bx		; CX:AX is old user stack pointer
		mov	bx, act_sp	; BX is activation stack pointer

@@1:		cmp	bx, act_stack
		jbe	@@4		; Reached bottom of stack
		cmp	cx, word ptr [bx].as_contour+2
		jne	@@2		; Different stack segment
		cmp	ax, word ptr [bx].as_contour+0
		jb	@@4		; Higher (less full) stack pointer
					;   means we can give up
		test	[bx].as_flags, AF_OVL
		jnz	@@3		; Stop on any vectored call

@@2:		sub	bx, type actstack_t
		jmp	@@1		; Try next record

@@3:		mov	ax, bx		; Unwind the stack...
		sub	ax, type actstack_t ; ...to the previous record
		call	act_unwind

@@4:		les	bx, ovl_src	; Pointer to actual code address
		mov	ax, es:[bx+2]	; Record segment we're returning to
		mov	last_seg, ax

		pop	es		; Saved on entry
		ret

pop_ovl_return	endp


; *******************************
; *	find_addr		*
; *	find_ovl_addr		*
; *******************************
;
;	Look up a non-overlaid or overlaid address in the
;	statistics table.
;
;	Entry:	DX:AX	Address		(find_addr)
;	or	DX	Overlay number	(find_ovl_addr)
;		AX	Offset
;	Exit:	CF	Set if not found
;		ES:BX	Points to stats entry
;

find_addr	proc	near

;	This entry for non-overlaid symbols.

		mov	es, stat_seg	; Stats table referenced by ES
		mov	bx, 0		; First symbol in non-overlayed part
		mov	cx, es:[0h].sh_nsyms ; Last symbol + 1

		jmp	short @@1

find_ovl_addr	label	near

;	This entry for overlaid symbols.

		mov	es, stat_seg	; Stats table referenced by ES
		mov	bx, es:[0h].sh_nsyms
		mov	cx, bx		; First symbol in overlaid part
		add	cx, es:[0h].sh_novsyms ; Last symbol + 1

@@1:		push	bp		; Standard stack frame
		mov	bp, sp
		push	dx		; DWORD [bp-4] is address
		push	ax
		push	si		; Save registers
		push	di

		mov	si, bx		; SI is left end marker
		mov	di, cx
		sub	di, 1		; DI is right end marker
		jc	@@4		; Jump if table empty
		cmp	di, si
		jc	@@4

@@2:		cmp	di, si		; Markers converged means entry
		jc	@@4		;   not found

		mov	ax, si		; For binary search, probe half way
		add	ax, di		;   between left and right ends:
		shr	ax, 1		;   AX = (SI + DI) / 2
IF type statentry_t eq 16
		mov	bx, ax
		mov	cl, 4
		shl	bx, cl		; BX = AX * type statentry_t
		mov	cx, ax		; Save for later
		add	bx, es:[0h].sh_symptr
ELSE
		mov	cx, ax		; Save for later
		mov	bx, type statentry_t
		mul	bx		; Offset into symbol table
		add	ax, es:[0h].sh_symptr
		mov	bx, ax		; ES:BX points to symbol entry
ENDIF

		mov	ax, [bp-4]	; Subtract addresses for comparison
		mov	dx, [bp-2]
		sub	ax, word ptr es:[bx].se_addr+0
		sbb	dx, word ptr es:[bx].se_addr+2
		jc	@@3		; Jump if table address > address
					;   we're looking for

		or	ax, dx		; Result zero means we found it,
		jz	@@4		;   carry is clear (as it happens)

		inc	cx		; Narrow search to half of partition
		mov	si, cx		;   above last probe
		jmp	@@2

@@3:		sub	cx, 1		; Narrow search to half below last
		jc	@@4		;   probe--check for underflow off
		mov	di, cx		;   bottom end of table
		jmp	@@2

@@4:		pop	di		; All done
		pop	si
		mov	sp, bp
		pop	bp
		ret

find_addr	endp


; *******************************
; *	need_patch		*
; *******************************
;
;	We have hit an INT 3 that is not a function entry point
;	or a return from anything on the stack.  What it should
;	be is a return from an indirect call which, in an
;	earlier invocation, called a profiled function.  So we
;	need to find ANY return address on the stack that
;	matches this address.
;
;	Entry:	DX:AX	Address to match
;	Exit:	CF	Set if not matched
;		BX	Stack pointer
;

need_patch	proc	near

		mov	bx, act_sp	; BX points into activation stack

@@1:		cmp	bx, act_stack
		jbe	@@3		; Reached bottom of stack
		test	[bx].as_flags, AF_OVL
		jnz	@@2		; Not interested in vectored calls
		cmp	ax, word ptr [bx].as_return+0
		jne	@@2		; Return address doesn't match
		cmp	dx, word ptr [bx].as_return+2
		je	@@4		; Return address matches: use it
@@2:		sub	bx, type actstack_t
		jmp	@@1		; Try next record

@@3:		stc			; Bottom of stack; search failed
@@4:		ret

need_patch	endp


; *******************************
; *	push_call		*
; *******************************
;
;	Push a new activation stack frame for a function call.
;	Checks for branch rather than call (tail recursion,
;	other weird stuff; also necessary to handle case of
;	breakpoint on program entry).
;
;	Entry:	DX:AX	User stack pointer
;		BX	Stats table offset for call
;

push_call	proc	near

		push	si		; Save registers
		push	di
		push	es

;	If contour has gone down (stuff removed from stack), we
;	need to pop some stack frames.  Search for the topmost
;	frame with contour deeper or equal to current.  As a
;	side-effect, this finishes off timing for the topmost
;	frame.

		push	ax		; Save for later
		push	dx

		mov	si, act_sp	; SI points into activation stack

@@1:		cmp	si, act_stack
		jbe	@@2		; Reached bottom of stack
		cmp	dx, word ptr [si].as_contour+2
		jne	@@2		; Different segment: go no further
		cmp	ax, word ptr [si].as_contour+0
		jbe	@@2		; Lower contour: go no further
		sub	si, type actstack_t
		jmp	@@1		; Try next record

@@2:		push	bx		; Save for later
		mov	ax, si		; Unwind stack to this level
		call	act_unwind
		pop	bx

		pop	dx		; Recover user stack pointer
		pop	ax

;	If the current contour is equal to the one on the top
;	stack frame, we must have arrived here by a jump rather
;	than a call.

		cmp	dx, word ptr [si].as_contour+2
		jne	@@3		; Different contour
		cmp	ax, word ptr [si].as_contour+0
		jne	@@3		; Different contour

		mov	es, dx		; Get user stack pointer into ES:DI...
		mov	di, ax
		mov	ax, es:[di+2]	; ...so we can get execution address
		mov	last_seg, ax	;   from INT 3 frame

		pop	es		; Saved on entry
		pop	di
		pop	si
		ret

;	Is there room for another frame on the stack?

@@3:		add	si, type actstack_t ; Allocate a frame
		cmp	si, act_limit	; Over limit?
		jb	@@4		; No - okay

;	Stack overflow!  Sudden death.

		mov	al, XC_OFLO	; Stack overflow error
		call	forget_it	; Disable profiler

		mov	ax, 4CFFh	; Execution resumes at child_return
		int	21h

;	Fill in the new stack frame.

@@4:		mov	[si].as_area, bx ; Called area ID
		mov	word ptr [si].as_contour+0, ax ; Stack contour
		mov	word ptr [si].as_contour+2, dx

;	Here's the hard part.  How do we know if we got here by
;	a near or far call?  We guess.  If the last known code
;	address was in a different segment, we assume a far call.
;	In the same segment we assume a near call (which is okay
;	even if it was far, because the segment on the stack is
;	the same as last_seg).  You can spend some time amusing
;	yourself thinking up ways this can fail.

		mov	es, dx		; ES:DI points to user stack
		mov	di, ax
		mov	ax, es:[di+6]	; Offset of user return address
		mov	dx, es:[di+2]	; Segment of INT 3 return address
		cmp	dx, last_seg	; Compare segments...
		je	@@5		; ...tread same segment as near call
		mov	last_seg, dx	; Current segment changed
		mov	dx, es:[di+8]	; Segment of user return address
@@5:		mov	word ptr [si].as_return+0, ax ; Save call return
		mov	word ptr [si].as_return+2, dx ;   address

;	Get source and target flags.

		call	act_search	; Look for matching frames
		test	al, AF_SOURCE or AF_DOUBLE ; Nested or double call?
		jnz	@@6		; Don't need to add breakpoint

		les	bx, [si].as_return
		mov	ah, es:[bx]	; Retrieve opcode
		mov	byte ptr es:[bx], INT3 ; Insert breakpoint
		cmp	ah, INT3	; Already breakpoint there?
		jne	@@6

;	Inserted a breakpoint on top of another breakpoint.  This is
;	probably one of those nasty double-entry situations, where
;	the return address of a call has a public label.  Look for
;	the label to find the real original opcode.

		push	ax		; Save flags
		mov	ax, bx
		mov	dx, es		; DX:AX is breakpoint address
		call	find_addr	; Look up address
		pop	ax
		jc	@@6		; Not found
		or	al, AF_DOUBLE	; Mark activation record as double
		mov	ah, es:[bx].se_saveop ; Get real original opcode

@@6:		mov	[si].as_flags, al ; Save flags, opcode
		mov	[si].as_saveop, ah

push_call_init	label	near		; Common code with push_ovl_call

;		Initialize function times.

		xor	ax, ax		; Everything starts at zero
		mov	word ptr [si].as_fcntime+0, ax
		mov	byte ptr [si].as_fcntime+2, al
		mov	word ptr [si].as_cumtime+0, ax
		mov	byte ptr [si].as_cumtime+2, al

		mov	act_sp, si	; Update stack pointer

;	Increment call count for this function.

		mov	es, stat_seg
		mov	bx, [si].as_area ; ES:BX points to stats entry
		add	word ptr es:[bx].se_ncalls+0, 1
		adc	word ptr es:[bx].se_ncalls+2, 0

push_call_ret	label	near		; Common code with push_ovl_call

		pop	es		; Saved on entry
		pop	di
		pop	si
		ret

push_call	endp


; *******************************
; *	push_ovl_call		*
; *******************************
;
;	Push an activation stack frame for a call to an overlaid
;	function.
;
;	Entry:	CX:BX	User stack pointer
;		Other info retrieved from user stack and overlay
;		manager data.
;

push_ovl_call	proc	near

		push	si		; Save registers
		push	di
		push	es

;	If contour has gone down (stuff removed from stack), we
;	need to pop some stack frames.  Search for the topmost
;	frame with contour deeper or equal to current.  As a
;	side-effect, this finishes off timing for the topmost
;	frame.

		push	bx		; Save for later
		push	cx

		mov	si, act_sp	; SI points into activation stack

@@1:		cmp	si, act_stack
		jbe	@@2		; Reached bottom of stack
		cmp	cx, word ptr [si].as_contour+2
		jne	@@2		; Different segment: go no further
		cmp	bx, word ptr [si].as_contour+0
		jbe	@@2		; Lower contour: go no further
		sub	si, type actstack_t
		jmp	@@1		; Try next record

@@2:		mov	ax, si		; Unwind stack to this level
		call	act_unwind

;	Keep track of number of calls.

		add	word ptr auxheader.ah_ovlcalls+0, 1
		adc	word ptr auxheader.ah_ovlcalls+2, 0

;	Find the stats table entry for this function.

		les	bx, ovl_dest_id	; Destination ID or table index
		mov	dx, es:[bx]	; DX is ID/index...
		and	dx, 3FFFh	; ...bottom 14 bits only
		les	bx, ovl_src_id	; Source ID flag tells kind of call
		test	word ptr es:[bx], 4000h ; Check for segment call
		jnz	@@2a
		les	bx, ovl_lookup	; Not segment call, need to use
		mov	es, es:[bx]	;   overlay table to translate
		mov	bx, dx		;   identifier to overlay ID
		shl	bx, 1
		shl	bx, 1
		shl	bx, 1		; Eight-byte entries
		mov	dx, es:[bx-6]	; Get ID (offset 2 in table record,
					;   but DX was 1 too high, so
					;   subtract 8, add 2, gives -6)

@@2a:		les	bx, ovl_dest
		mov	ax, es:[bx+2]	; Actual segment of overlay area
		mov	last_seg, ax	; Record for near/far determination
		mov	ax, es:[bx+0]	; Offset of target in segment

		call	find_ovl_addr	; Find stats table entry

		pop	dx		; Retrieve user stack pointer
		pop	ax

		jc	push_call_ret	; Couldn't find it - should not happen
		test	es:[bx].se_flags, SF_DATA
		jne	push_call_ret	; Data address - happens when we've
					;   lied and marked entries as DATA
					;   to prevent stats gathering

;	Is there room for another frame on the stack?

		add	si, type actstack_t ; Allocate a frame
		cmp	si, act_limit	; Over limit?
		jb	@@3		; No - okay

;	Stack overflow!  Sudden death.

		mov	al, XC_OFLO	; Stack overflow error
		call	forget_it	; Disable profiler

		mov	ax, 4CFFh	; Execution resumes at child_return
		int	21h

;	Fill in the new stack frame.

@@3:		mov	[si].as_area, bx ; Called area ID
		mov	word ptr [si].as_contour+0, ax ; Stack contour
		mov	word ptr [si].as_contour+2, dx

		call	act_ovl_search	; Get target flag; don't need any
		mov	[si].as_flags, al ;   others for overlay call

		jmp	push_call_init	; Join up with common code in
					;   push_call

push_ovl_call	endp


; *******************************
; *	track_loads		*
; *******************************
;
;	Called when we arrive at the overlay manager's "load an
;	overlay" entry.  Record overlay number loaded, and
;	whether it was a load or reload.
;
;	Entry:	Information retrieved from overlay manager data
;		area.
;

track_loads	proc	near

		push	es		; Save register

		les	bx, ovl_is_call	; Get load/reload flag
		cmp	byte ptr es:[bx], 0
		jz	@@1		; It's a reload

		add	word ptr auxheader.ah_nloads+0, 1
		adc	word ptr auxheader.ah_nloads+2, 0
		xor	ax, ax		; First double-word holds load count
		jmp	short @@2

@@1:		add	word ptr auxheader.ah_nreloads+0, 1
		adc	word ptr auxheader.ah_nreloads+2, 0
		mov	ax, 4		; Second double-word is reload count

@@2:		les	bx, ovl_dest	; Get overlay number being loaded
		mov	bx, es:[bx+2]	;   from segment part of DWORD
		and	bx, 3FFFh	; Lower 14 bits only
		dec	bx		; Overlay numbers start at 1

		mov	es, stat_seg	; ES used to reference stats table
		cmp	bx, es:[0h].sh_novls ; Invalid overlay number?
		jae	@@3		; Yes - just ignore it

		shl	bx, 1
		shl	bx, 1
		shl	bx, 1		; Eight-byte table entries
		add	bx, ax		; Choose load or reload count
		add	bx, es:[0h].sh_ovlptr ; ES:BX points to 4-byte count
		add	word ptr es:[bx+0], 1 ; Increment count
		adc	word ptr es:[bx+2], 0

@@3:		pop	es		; Saved on entry
		ret

track_loads	endp


; *******************************
; *	act_search		*
; *******************************
;
;	Search the activation stack for other calls from this
;	location, and other calls to this routine.  If we find
;	another call from this location, we recover the old
;	saved opcode, which has been replaced by a breakpoint.
;	This entry for call from non-overlaid area only.
;
;	Entry:	DX:AX	Return address
;		BX	Stats table offset of called routine
;	Exit:	AL	Activation flags
;		AH	Old saved opcode
;

act_search	proc	near

		push	si		; Save register

		mov	si, act_sp	; SI points into activation stack
		xor	cx, cx		; CX holds value to return in AX

@@1:		cmp	si, act_stack	; Hit bottom of stack?
		jbe	@@4

		test	[si].as_flags, AF_OVL
		jnz	@@2		; Source in overlay, so this can't
					;   be our return address
		cmp	ax, word ptr [si].as_return+0
		jnz	@@2		; Not our return address
		cmp	dx, word ptr [si].as_return+2
		jnz	@@2		; Not our return address

		or	cl, AF_SOURCE	; Yes, source is nested
		mov	ch, [si].as_saveop

@@2:		cmp	bx, [si].as_area
		jnz	@@3		; Not call to same routine

		or	cl, AF_TARGET	; Flag nested target (recursion)

@@3:		sub	si, type actstack_t
		test	cl, AF_SOURCE	; Keep going till found both source...
		jz	@@1
		test	cl, AF_TARGET	; ...and target, or till bottom of
		jz	@@1		;   stack reached

@@4:		mov	ax, cx		; Return stuff in AX

		pop	si		; Restore register
		ret

act_search	endp


; *******************************
; *	act_ovl_search		*
; *******************************
;
;	Search the activation stack for other calls to this
;	routine.  In overlays, we don't care if the source is
;	nested, because there are no breakpoints to add and
;	delete.
;
;	Entry:	BX	Stats table offset of called routine
;	Exit:	AL	Activation flags
;

act_ovl_search	proc	near

		push	si		; Save register

		mov	si, act_sp	; SI points into activation stack
		mov	al, AF_OVL	; Assume no other calls
@@1:		cmp	si, act_stack
		jbe	@@3		; Hit bottom of stack
		cmp	bx, [si].as_area
		jne	@@2		; Not same area
		or	al, AF_TARGET	; Flag nested target (recursion)
		jmp	short @@3
@@2:		sub	si, type actstack_t
		jmp	@@1		; Try next frame

@@3:		pop	si		; Restore register
		ret

act_ovl_search	endp


; *******************************
; *	act_unwind		*
; *******************************
;
;	Unwind the activation stack.  The user program's stack
;	contour has gone down, and we must take things off the
;	activation stack to match it.  Timings on the stack get
;	attributed back up as appropriate.
;
;	Entry:	AX	Desired activation stack pointer
;

act_unwind	proc	near

		push	si		; Save registers
		push	di
		push	es

		mov	si, act_sp	; SI holds activation stack pointer
		mov	di, ax		; DI holds desired pointer
		mov	es, stat_seg	; ES points to stats table, usually

;	Time in current function gets added to record on top of
;	stack.  Note that fcn_time can't change while we're in
;	the profiler, so there's no need to disable interrupts
;	or whatever.

		mov	ax, word ptr fcn_time+0 ; Time in current function
		mov	dl, byte ptr fcn_time+2
		add	word ptr [si].as_fcntime+0, ax ; Add to function time
		adc	byte ptr [si].as_fcntime+2, dl
		add	word ptr [si].as_cumtime+0, ax ; Add to cumulative
		adc	byte ptr [si].as_cumtime+2, dl

		xor	ax, ax		; Oh, and don't forget to reset it
		mov	word ptr fcn_time+0, ax
		mov	byte ptr fcn_time+2, al

;	Now we loop, throwing away activation records and clean-
;	ing up after them until we get to the desired level.

@@1:		cmp	si, di		; Gone far enough?
		jbe	@@6

		mov	bx, [si].as_area ; Stats entry for this frame

;	Time in function always gets added to statistics table
;	entry for this function.  Remember those three-byte time
;	values!

		mov	ax, word ptr [si].as_fcntime+0 ; Add function time...
		mov	dl, byte ptr [si].as_fcntime+2
		add	word ptr es:[bx].se_fcntime+0, ax ; ...to stats entry
		adc	byte ptr es:[bx].se_fcntime+2, dl

;	We do a couple of things with cumulative time....

		mov	ax, word ptr [si].as_cumtime+0
		mov	dl, byte ptr [si].as_cumtime+2

;	Cumulative time only gets added to statistics entry if
;	this is not a nested invocation.  Otherwise, cumulative
;	time would get attributed more than once: here, and when
;	that previous invocation got popped.

		test	[si].as_flags, AF_TARGET
		jnz	@@2		; Recursive routine
		add	word ptr es:[bx].se_cumtime+0, ax
		adc	byte ptr es:[bx].se_cumtime+2, dl
@@2:

;	Cumulative time here goes to caller's cumulative time.

		add	word ptr [si-type actstack_t].as_cumtime+0, ax
		adc	byte ptr [si-type actstack_t].as_cumtime+2, dl

;	If the call source was not nested, we need to remove the
;	breakpoint from the return point.

		test	[si].as_flags, AF_SOURCE or AF_OVL or AF_DOUBLE
		jnz	@@5		; Don't bother if overlaid (no
					;   breakpoint) or if the breakpoint
					;   should stay for later
		mov	al, [si].as_saveop ; Original opcode
		les	bx, [si].as_return ; Breakpoint address
		mov	es:[bx], al	; Remove INT 3
		mov	es, stat_seg	; Restore normal value
@@5:

		sub	si, type actstack_t
		jmp	@@1		; Go to next activation stack frame

@@6:		mov	act_sp, si	; Store new, lower stack pointer

		pop	es		; Saved on entry
		pop	di
		pop	si
		ret

act_unwind	endp


; *******************************
; *	forget_it		*
; *******************************
;
;	We are screwed.  Something has gone badly wrong, and the
;	best thing to do now is to disable the profiler and try
;	to continue till the user program exits.  So, take out
;	all breakpoints and we'll let it go at that.
;
;	(We don't actually need to remove breakpoints, except in
;	a few exceptional cases when the programmer has done
;	some very dirty low-level tricks.  However, I use those
;	VDLLTs myself, so covering bases sounds like a good
;	idea.)
;
;	Entry:	AL	Reason for bailing out
;

forget_it	proc	near

		mov	prof_status, al	; Flags that we're canceling

		mov	ax, act_stack	; Bottom of stack
		call	act_unwind	; Remove all return breakpoints
		call	del_break	; Remove all function breakpoints

		ret

forget_it	endp


; *******************************
; *	mem_error		*
; *******************************
;
;	Report out of memory and terminate.  Does not return.
;

mem_error	proc	near

		mov	bx, 2		; stderr
		movi	dx, <db CRLF, "Out of memory", CRLF, 0>
		call	writestr

		mov	ax, 4C01h	; Exit with error code 1
		int	21h

mem_error	endp


; *******************************
; *	dos_error		*
; *******************************
;
;	Report DOS error and terminate.  Does not return.
;
;	Entry:	AX	Error code
;		BX	Points to file name
;		DX	Points to string describing operation
;			involved ("read", "write", etc.)
;

dos_error	proc	near

		push	si		; Only a total lunatic would save
					;   a register that's never going
					;   to be restored.  Heh heh heh.

		push	ax		; Save error code for later

;	First part of error message.

		push	bx		; File name
		push	dx		; Thing we tried to do to file
		mov	bx, 2		; stderr
		movi	si, <db CRLF, "Can't %s file %s: ", 0>
		call	fprintf
		add	sp, 4

;	Search for error message matching this code.

		pop	bx		; Retrieve error code...
		push	bx		; ...but save in case not matched
		mov	di, offset RES:dos_messages
		call	get_message	; Find message text
		jc	@@3		; Jump if no message for this code

;	Found error message for this code.

@@2:		add	sp, 2		; Discard stacked BX
		push	di		; Error message text
		mov	bx, 2		; stderr
		movi	si, <db "%s", CRLF, 0>
		call	fprintf
		add	sp, 2

		jmp	short @@4

;	No error message, just give the DOS code.  BX (error
;	code) is still on the stack.

@@3:		mov	bx, 2		; stderr
		movi	si, <db "DOS error code %u", CRLF, 0>
		call	fprintf
		add	sp, 2

@@4:		mov	ax, 4C01h	; I could just die
		int	21h

dos_error	endp


; *******************************
; *	get_message		*
; *******************************
;
;	Scan a message text table for a message corresponding to
;	a given code.  Each entry in a message table has a one-
;	byte code followed by a null-terminated ASCII string.
;	the table ends with a zero code.
;
;	Entry:	DI	Points to table
;		BL	Is the code
;	Exit:	CF	Set if no message found
;		DI	Points to message text
;

get_message	proc	near

		push	es		; Save register
		mov	ax, RES
		mov	es, ax		; ES=DS for SCASB

		xor	al, al		; Zero for SCASB
		mov	cx, 0FFFFh	; No limit on SCASB
@@1:		cmp	byte ptr [di], 0
		stc			; Carry set indicates failure
		jz	@@2		; Terminate on zero code
		cmp	bl, byte ptr [di]
		je	@@2		; Jump (carry clear) if matched
	repne	scasb			; Skip over message text...
		jmp	@@1		; ...and try again

@@2:		inc	di		; DI now points to message text

		pop	es		; Saved on entry
		ret

get_message	endp


; *******************************
; *	fprintf			*
; *******************************
;
;	Similar to C's fprintf() function.  Intended for writing
;	messages to the screen.  Understands "u", "c", "s", and
;	"X" (four-digit hex) format descriptors, with near
;	pointers for "s".
;
;	Entry:	BX	Handle
;		SI	Points to format string
;		Stack	Other parameters
;

fprintf		proc	near

		push	bp		; Standard stack frame
		mov	bp, sp
		sub	sp, 2		; Local storage for file handle
		push	si
		push	di

		mov	[bp-2], bx	; WORD [bp-2] is file handle
		mov	di, bp
		add	di, 4		; DI points to first stacked argument

;	Parse format string.

@@1:		mov	bx, [bp-2]	; File handle, will be used later
		lodsb			; Next character from format string
		cmp	al, '%'		; '%'...
		jz	@@3		; ...introduces format descriptor
@@2:		test	al, al		; Null character...
		jz	@@7		; ...ends format string
		call	writechr	; Otherwise just write the thing
		jmp	@@1		;   and get the next character

;	Found "%", get format character.

@@3:		lodsb			; Character following '%'
		cmp	al, 'c'
		jz	@@4
		cmp	al, 's'
		jz	@@5
		cmp	al, 'X'
		jz	@@6
		cmp	al, 'u'
		jnz	@@2		; Didn't match, display normally
					;   (handles null character too)

;	Unsigned decimal number.

		mov	ax, [di]	; Get argument from stack
		add	di, 2		;   and advance argument pointer
		call	writedec	; Write number as decimal
		jmp	@@1		;   and continue

;	Single character.

@@4:		mov	ax, [di]	; Get argument from stack
		add	di, 2		;   and advance argument pointer
		call	writechr	; Write character
		jmp	@@1		;   and continue

;	Null-terminated string.

@@5:		mov	dx, [di]	; Get argument from stack
		add	di, 2		;   (you know the rest by now)
		call	writestr	; Write string
		jmp	@@1		;   and continue

;	Four digits hexadecimal.

@@6:		mov	ax, [di]	; Get argument from stack
		add	di, 2
		call	writehex	; Write hexadecimal number
		jmp	@@1

@@7:		pop	di		; Clean up and exit
		pop	si
		mov	sp, bp
		pop	bp
		ret

fprintf		endp


; *******************************
; *	writedec		*
; *******************************
;
;	Write an unsigned decimal number to a file.
;
;	Entry:	AX	Number
;		BX	Handle
;	Exit:	CF	Error flag
;		AX	Error code
;

writedec	proc	near

		push	bp		; Need local storage for handle
		mov	bp, sp
		push	bx		; Local: file handle

		xor	cx, cx		; Number of digits
		mov	bx, 10		; Decimal divisor
@@1:		xor	dx, dx		; Zero top of 32-bit dividend
		div	bx		; Divide by ten
		add	dx, '0'		; Digit just generated...
		push	dx		; ...get saved on stack
		inc	cx		; Count digits pushed
		test	ax, ax		; End when nothing left
		jnz	@@1

@@2:		pop	ax		; Get last (highest) digit generated
		mov	bx, [bp-2]	; File handle
		push	cx
		call	writechr	; Write digit
		pop	cx
		loop	@@2

		mov	sp, bp		; Release locals
		pop	bp
		ret

writedec	endp


; *******************************
; *	writehex		*
; *******************************
;
;	Write a four-digit hexadecimal number to a file.
;
;	Entry:	AX	Number
;		BX	Handle
;	Exit:	CF	Error flag
;		AX	Error code
;

writehex	proc	near

		push	bp		; Need local storage for handle
		mov	bp, sp
		push	bx		; Local: file handle

		push	ax
		mov	al, ah		; Display high-order byte
		call	@@1
		pop	ax
		call	@@1		; Display low-order byte

		mov	sp, bp		; Release locals
		pop	bp
		ret

;	Subroutine: display two hex digits in AL.

@@1:		push	ax
		mov	cl, 4
		shr	al, cl		; High-order nibble
		call	@@2
		pop	ax		; Low-order nibble
;		Fall through....

;	Subroutine: display hex digit in low half of AL.

@@2:		and	al, 0Fh		; Mask off
		add	al, '0'		; Convert to ASCII digit
		cmp	al, '9'		; Digits over 9...
		jbe	@@3
		add	al, 'A'-'9'-1	; ...become A-F
@@3:		mov	bx, [bp-2]	; File handle
		call	writechr	; Display character
		ret

writehex	endp


; *******************************
; *	writechr		*
; *******************************
;
;	Write a single character to a file.  Intended for text
;	output to the screen.  For anything else, it would be
;	horrible.
;
;	Entry:	AL	Character
;		BX	Handle
;	Exit:	CF	Error flag
;		AX	Error code
;

writechr	proc	near

		push	bp		; Need local one-character buffer
		mov	bp, sp
		push	ax		; Save character on stack

		mov	ah, 40h		; DOS write to file
		mov	cx, 1		; Write one character...
		lea	dx, [bp-2]	; ...from buffer on stack
		int	21h

		mov	sp, bp		; Release locals
		pop	bp
		ret

writechr	endp


; *******************************
; *	writestr		*
; *******************************
;
;	Write null-terminated string to file.  Arguments same as
;	DOS INT 21h AH=40h except that length is omitted.
;
;	Entry:	BX	Handle
;		DX	Points to string
;	Exit:	CF	Error flag
;		AX	Bytes or error code
;

writestr	proc	near

		push	di		; Save registers
		push	es
		mov	ax, RES		; Need ES=DS for SCASB
		mov	es, ax

;	Determine string length.

		mov	di, dx		; DI points to string
		mov	cx, 0FFFFh	; Unlimited length
		xor	ax, ax		; Clear AH too for zero return
	repnz	scasb			; Find zero terminator
		not	cx		; Convert remaining count...
		dec	cx		; ...to length
		jz	@@1		; Don't write zero-length string

;	Write string.

		mov	ah, 40h
		int	21h

@@1:		pop	es		; Saved on entry
		pop	di
		ret

writestr	endp


RES_TEXT	ends

		end
