.TITLE	MAP		
; JEFFREY KODOSKY	ARL	NOV75
;
; SUBR
; ENTRY:	2 ARGS		<LIST>;<FNEXP>
; EXIT:		1 ARG
; ERRORS:	NONE
; CALLS:	APPLY
;		GETC
	.GLOBL	MAP,ZMAP,MAPLIST,ZMAPLIST,MAPCON,ZMAPCON
	.GLOBL	MAPC,ZMAPC,MAPCAR,ZMAPCAR,$ALIST,QGETC,QAPPLY
MAPC:	CLR	R3	;MAPC FLAG
	BR	MAP01
ZMAPC=.-MAPC
;
MAPCAR:	MOV	#4,R3	;MAPCAR FLAG
	BR	MAP01
ZMAPCAR=.-MAPCAR
;
MAPCON:	MOV	#10,R3	;MAPCON FLAG
	BR	MAP01
ZMAPCON=.-MAPCON
;
MAPLIST:MOV	#14,R3	;MAPLIST FLAG
	BR	MAP01
ZMAPLIST=.-MAPLIST
;
MAP:	MOV	#-4,R3	;MAP FLAG
MAP01:	ROOM	10.
	MOV	(R5)+,R0;<LIST>
	MOV	@R5,R1	;<FNEXP>
	CLR	@R5	;RESULT
	MOV	R5,R2
	MOV	R2,-(R5);OPEN CDR (NOT USED BY MAP)
	MOV	R1,-(R5)
	MOV	$ALIST,-(R5)
	MOV	R0,-(R5)
MAP02:	MOV	@R5,R0
	BEQ	MAP03	;NIL, ATOM, STRING, NUMBER
	BIT	#2,(R0)+;ALL TERMINATE MAP
	BNE	MAP03
	BIT	#3,@R0
	BEQ	MAP04
MAP03:	ADD	#10,R5	;FLUSH STACK AND RETURN
	JMP	@-(R4)	;ACCUMULATED RESULT
MAP04:	MOV	R3,-(R5);SAVE FLAG (OK SINCE IT POINTS OUTSIDE
	QGETC		;FREE SPACE)
	CMP	R3,#4
	BHI	MAP05
	MOV	@4(R5),@(R5)+
	BR	MAP06
MAP05:	MOV	4(R5),@(R5)+
MAP06:	TST	-(R5)	;(<LIST>) OR (CAR[<LIST>]) IF MAPCAR OR MAPC
	MOV	10(R5),-(R5)	;<FNEXP>
	QAPPLY		;APPLY[<FNEXP>;(<LIST>)]
	MOV	(R5)+,R2;RESULT
	MOV	(R5)+,R3;FLAG
	BLE	MAP10	;IGNORE RESULT IF MAP OR MAPC
	BIT	#4,R3	;IF MAPCAR OR MAPLIST, GET A CELL
	BEQ	MAP07	;JUMP IF MAPCON
	QGETC
	MOV	R2,@(R5)+	;AND STORE RESULT IN CAR
	MOV	-2(R5),R2	;NEW RESULT:=(RESULT)
MAP07:	MOV	R2,@6(R5)	;CONCATENATE TO PREVIOUS RESULT
MAP08:	BIT	#2,(R2)+	;FIND THE NEW CDR TO SAVE
	BNE	MAP10
	BIT	#3,@R2
	BNE	MAP10
	MOV	R2,6(R5);SAVE POINTER TO THIS CDR TEMPORARILY
	MOV	@R2,R2
	BNE	MAP08
MAP10:	MOV	(R5)+,R0
	MOV	@R5,$ALIST
	MOV	2(R0),-(R5)	;<LIST>:=CDR[<LIST>]
	BR	MAP02
ZMAP=.-MAP
	.END