		page	60,132
		title	MAXMIN Code Block
		subttl	Code Block Header
		page
		name	MAXMIN

;-------------------------------------------------------:
;							:
;	Functions:					:
;							:
;		MAX					:
;		MIN					:
;							:
;-------------------------------------------------------:

maxminseg	segment	para
		assume	CS:maxminseg

;
;  First the Object Header and Entry Descriptors:
;

baseloc		label byte	; This is the
				;  beginning of
				;  the entry object.

		db	1	; Define functions
				;  as LAMBDA, with
				;  variable number
				;  of arguments.

		dw	0	; Object length
				;  will be filled
				;  in by IQLISP.

;  Descriptor for MAX:

		db	1	; # of parameters.
		db	0	; Trace flag.
		dw	max_entry	; Entry point.

;  Descriptor for MIN:

		db	1	; # of parameters.
		db	0	; Trace flag.
		dw	min_entry	; Entry point.

		dw	0ffffh		; End-of-
					;  descriptors
					;  flag.
		subttl	Entry, Arg check, and Setup
		page
;
;  Interrupt codes used:
;

$$err		equ	0c1h	; ERROR.
$$ctlc		equ	0c4h	; Check for break.
$$arith		equ	0c6h	; Arithmetic.
$$ttest		equ	0c8h	; Type test.
		page

maxminproc	proc	far	; Entered by
				;  intersegment call.

max_entry:
		mov	AL,2	; Arithmetic code for
				;  LT compare.
		jmp	short max_min_com
min_entry:
		mov	AL,9	; Arithmetic code for
				;  GT compare.

max_min_com:
		mov	[BP-10+1],AL	; Save comparison
					;  type in stack.
		int	$$ttest		; Is argument an
					;  empty list?
		jnc	setup		;  No - set up for
					;     scan of list.
		xor	CX,CX		;  Yes - invoke
		mov	DL,13h		;     ERROR with
		int	$$err		;	code = 0.
		inc	SP
		inc	SP	; Pop R code off stack.
		ret		; Return result of ERROR.

setup:
		sub	SP,8	; Allocate work space.
		sub	BP,14	; BP -> work frame 1.

		subttl	Main Processing
		page
;
;  The stack is now organized as follows:
;
;		 -----------------------
;		|			|   (Entry .
;		|----------		|	Refarray)
; [BP+14]->	|    P	   |		|
;		 -----------------------
;		|			|
;		|----------		|   Arg list.
; [BP+10]->	|    P	   |		|
;		 -----------------------
;		|			|   Intersegment
;		|			|     return.
;		|			|
;		|-----------------------|
; [BP+4]->	|    R	   |	CC	|   CC is compare
;		 -----------------------	code.
;		|			|   Work frame 1:
;		|----------		|    holds extreme
; [BP]->	|    P	   |		|    value so far.
;		 -----------------------
;		|			|   Work frame 2:
;		|----------		|    holds current
; [SP],[BP-4]->	|    P	   |		|    value for compare.
;		 -----------------------
;

		mov	byte ptr [BP],'P'     ; Mark work
		mov	byte ptr [BP-4],'P'   ;   frames.

		mov	DL,DS:[SI]
		and	DL,1fh		; Get car of arglist,
		mov	CX,DS:[SI+1]	;  i.e., 1st arg.

		mov	[BP+1],DL
		mov	[BP+2],CX	; Work frame 1 gets
					;  max (min) so far.

		mov	DL,DS:[SI+3]
		mov	CX,DS:[SI+4]	; Cdr of arglist
					;  is rest of args.

loop:
		int	$$ttest		; End of arglist?
		jc	done		;  Yes - cdr is NIL.

		mov	DL,DS:[SI+3]	;  No - save rest of
		mov	CX,DS:[SI+4]	;   args for later.
		mov	[BP+10+1],DL	;  Cdr of list is
		mov	[BP+10+2],CX	;   saved in arg
					;   frame.
		mov	DL,DS:[SI]	; RDC = car of
		and	DL,1fh		;  this cell,
		mov	CX,DS:[SI+1]	;  i.e., next arg.

		mov	[BP-4+1],DL	; New arg placed
		mov	[BP-4+2],CX	;  in work frame 2.

		mov	AL,[BP+4+1]	; Get compare code.
		int	$$arith		; Do compare.

		cmp	DL,14h		; Is result NIL?
		je	nextarg		;  Yes - previous
					;   max (min) is
					;   still extreme.

		mov	DL,[BP-4+1]	;  No - we have a
					;	new winner.
		mov	CX,[BP-4+2]	;	Put its id
		mov	[BP+1],DL	;	 in frame 1.
		mov	[BP+2],CX
nextarg:
		int	$$ctlc		; Check for break.
		mov	DL,[BP+10+1]	; Pick up remaining
		mov	CX,[BP+10+2]	;  args list,
		jmp	loop		; and continue.
done:
		mov	DL,[BP+1]	; The max (min) so
		mov	CX,[BP+2]	;  far is the winner.
		add	BP,14		; Restore BP value.
		lea	SP,[BP-8]	; Set SP for return,
		ret			;  and go back
					;   to the caller.

maxminproc	endp

;
;	Now we put in the entry object closing info:
;

		db	'MAXMIN'	; This is the
					;  entry object name.
		db	6		; This is the
					;  entry object
					;  name length.

;	Next we check to see if we need any padding
;	  and if so, generate it.
;
		if	($-baseloc) mod 16
		db	(16-(($-baseloc) mod 16)) dup (0)
		endif

maxminseg	ends

		end
