.TITLE	APPLY		
; JEFFREY KODOSKY	ARL	NOV75
;
; SUBR
; ENTRY:	2 ARGS		<FUNCTION>;<LIST>
; EXIT:		1 ARG		<FUNCTION>[<LIST>]
; ERRORS:	A2, FUNCTION OBJECT HAS NO DEFINITION-APPLY
;		F2, UNMATCHED ARGUMENTS ON EXPR CALL
; CALLS:	GET, SEARCH PROPERTY LIST
;		SASSOC, SEARCH DOTTED PAIR LIST
;		CDR
;		CAR
;		CONS
;		EVAL
;		PAIR
;		NCONC
; TRANSFERS TO EVAL MODULE TO SPREAD ARGS AND TO CHECK
; FOR TRACED EXPRS OR FEXPRS.
	.GLOBL	APPLY,ZAPPLY,QGET,EXPR,SUBR,$ALIST,QCDR
	.GLOBL	QCAR,QCONS,QEVAL,QPAIR,QNCONC,QSASSOC
	.GLOBL	QA2ERR,QF2ERR,LABEL,FUNARG,LAMBDA
	.GLOBL	SUBEXP
APPLY:	MOV	@R5,R0	;GET <FN>
	BNE	APLY01
	MOV	(R5)+,@R5	;NULL[<FN>]--->NIL
	JMP	@-(R4)
APLY01:	BIT	#2,(R0)+;UNEXPECTED NUMBER OR STRING--->
	BNE	APLY07	;A2 ERROR
	BIT	#2,@R0
	BNE	APLY07
	ROOM	6	;CHECK FOR ADEQUATE STACK SPACE
	BIT	#1,@R0	;ATOM[<FN>]--->
	BEQ	APLY10
	CLR	-(SP)
	MOV	EXPR,-(R5)	;GET[<FN>;EXPR]--->
	MOV	2(R5),-(R5)
	QGET
	BCC	APLY02
	MOV	SUBR,@R5	;GET[<FN>;SUBR]--->
	MOV	2(R5),-(R5)
	QGET
	BCS	APLY03
	INC	@SP
APLY02:	MOV	4(R5),R0	;<GET[...]>[<ARGLIST>]
	MOV	2(R5),4(R5)	;RE-ARRANGE STACK PRIOR TO
	MOV	(R5)+,@R5	;CALLING APPLY OR SUBR
	MOV	R0,-(R5);JUMP TO EVAL MODULE TO TEST FOR
	JMP	SUBEXP	;TRACING OR TRACESETTING
APLY03:	CLR	@R5
	TST	(SP)+
	MOV	$ALIST,-(R5)	;T--->APPLY[CDR[SASSOC[<FN>;
	MOV	4(R5),-(R5)	;     ALIST;<ERROR A2>]];<ARGLIST>]
	QSASSOC
	MOV	(R5)+,R0
	BEQ	APLY07	;JUMP IF NO BINDING FOUND
	MOV	R0,@R5
	QCDR
	BR	APPLY
APLY07:	QA2ERR
APLY10:	CMP	-(R0),LABEL	;EQ[CAR[<FN>];LABEL]--->
	BNE	APLY12
	MOV	2(R0),R3;APPLY[CADDR[<FN>];<ARGLIST>]
	MOV	R3,@R5	;ALIST:=CONS[CONS[CADR[<FN>];CADDR[<FN>]
	QCDR		; ];ALIST]
	QCAR
	MOV	@R5,R2	;R2:=CADDR[<FN>]
	MOV	$ALIST,-(R5)
	MOV	R2,-(R5)
	MOV	R3,-(R5);R3:=CDR[<FN>]
	QCAR
	QCONS
	QCONS
	MOV	(R5)+,$ALIST
	BR	APPLY
APLY12:	CMP	@R0,FUNARG	;EQ[CAR[<FN>];FUNARG]--->
	BNE	APLY14	;APPLY[CADR[<FN>;<ARGLIST>]
	MOV	2(R0),R3;ALIST:=CADDR[<FN>]
	MOV	R3,@R5
	QCAR		;CADR[<FN>]
	MOV	R3,-(R5);BUILD NEW ALIST
	QCDR
	QCAR
	MOV	(R5)+,$ALIST
	BR	APPLY
APLY14:	CMP	@R0,LAMBDA	;EQ[CAR[<FN>;LAMBDA]--->
	BNE	APLY16
	MOV	2(R0),R3;EVAL[CADDR[<FN>]]
	TST	(R5)+	;ALIST:=NCONC[PAIR[CADR[<FN>];
	MOV	@R5,R2	;    <ARGLIST>];ALIST]
	MOV	R3,@R5	;CDR[<FN>]
	QCDR
	QCAR		;CADDR[<FN>]
	MOV	$ALIST,-(R5)
	MOV	R2,-(R5)
	MOV	R3,-(R5)
	QCAR
	QPAIR		;PAIR[CADR[<FN>];<ARGLIST>]
	BCC	APLY15
	QF2ERR		;ERROR F2 IF INCORRECT NUMBER OF ARGS
APLY15:	QNCONC
	MOV	(R5)+,$ALIST
	QEVAL
	.WORD	0	;NO RETURN PATH SAVED
APLY16:	MOV	$ALIST,@R5	;T--->APPLY[EVAL[<FN>];<ARGLIST>]
	MOV	R0,-(R5);SAVE PRESENT CONTEXT
	QEVAL
	MOV	(R5)+,R0
	MOV	@R5,$ALIST	;RESTORE CONTEXT
	MOV	R0,@R5
	BR	APPLY
ZAPPLY=.-APPLY
	.END