.TITLE	PROG		
; JEFFREY KODOSKY	ARL	NOV75
;
; FSUBR
; ENTRY:	1 ARG		<LIST>
; EXIT:		1 ARG		NIL
; ERRORS:	NONE
; CALLS:	EVAL
;		CDR
;		CAR
;		ATOM
;		CONS
	.GLOBL	PROG,ZPROG,QEVAL,QCAR,QCDR,QCONS
	.GLOBL	QATOM,$ALIST,ADPROG
PROG:	ROOM	5
	MOV	@R5,-(R5)
	QCAR		;GET LOCAL VARIABLE LIST
	MOV	@R5,R3
	MOV	$ALIST,@R5	;DOT EACH VARIABLE WITH NIL
1$:	CLR	-(R5)	;AND PUT THEM AT THE FRONT OF THE ALIST
	MOV	R3,-(R5)
	BEQ	2$
	QCAR
	QCONS
	QCONS
	MOV	R3,-(R5)
	QCDR
	MOV	(R5)+,R3
	BR	1$
2$:	CMP	(R5)+,(R5)+
	MOV	2(R5),-(R5)
	QCDR		;GET BODY OF PROGRAM
	MOV	@R5,4(R5)	;SAVE CURRENT PROG PC
	MOV	@R5,R3
	CLR	@R5	;MAKE A GO-LIST
PROG1:	MOV	R3,-(R5);IS CAR OF PROG BODY REMAINDER ATOMIC?
	BEQ	PROG4	;(JUMP IF END OF PROG)
	QCAR
	QATOM
	TST	(R5)+
	BEQ	PROG2	;JUMP IF NOT
	MOV	R3,-(R5);YES: CONS IT TO GO-LIST
	QCONS
PROG2:	MOV	R3,-(R5);GET CDR OF PROG BODY
	QCDR
	MOV	(R5)+,R3
	BR	PROG1
PROG4:	TST	(R5)+	;GO-LIST IS COMPLETE, POP NIL
	INC	@R5	;MARK STACK
PROG6:	MOV	4(R5),-(R5)	;GET NEXT EXPR TO EVAL
	BEQ	PROG9	;JUMP IF END OF PROG
	MOV	@R5,-(R5)	;SOTRE UPDATED PROG PC
	QCDR
	MOV	(R5)+,6(R5)
	QCAR
	MOV	@R5,-(R5)	;IS THIS A LABEL OR EXPR?
	QATOM
	TST	(R5)+
	BNE	ADPROG	;JUMP IF LABEL
	MOV	4(R5),$ALIST	;RESET CONTEXT
	QEVAL		;EVALUATE EXPRESSION
ADPROG:	TST	(R5)+	;IGNORE VALUE
	BR	PROG6
PROG9:	ADD	#6,R5	;POP GARBAGE
	CLR	@R5	;AND RETURN NIL
	JMP	@-(R4)
ZPROG=.-PROG
	.END