	.TITLE	PAIR		
; JEFFREY KODOSKY	ARL	NOV75
;
; SUBR
; ENTRY:	2 ARGS		<LIST1>;<LIST2>
; EXIT:		1 ARG		<DOTTED PAIR LIST>
;		C BIT SET IF UNEQUAL LENGTH LISTS
; ERRORS:	NONE
; CALLS:	GETC
;		CONS
;		CAR
;		CDR
	.GLOBL	PAIR,ZPAIR,QGETC,QCAR,QCDR,QCONS
PAIR:	ROOM	4
	CLR	-(R5)	;RESULT
	MOV	R5,R0
	MOV	R0,-(R5);OPEN CDR
PAIR1:	MOV	6(R5),R3;LIST2
	BEQ	PAIR4
	MOV	R3,-(R5)
	QCDR
	MOV	@R5,10(R5)	;LIST2:=CDR[LIST2]
	MOV	R3,@R5
	QCAR
	MOV	6(R5),R3
	BEQ	PAIR6
	MOV	R3,-(R5)
	QCDR
	MOV	@R5,10(R5)	;LIST1:=CDR[LIST1]
	MOV	R3,@R5
	QCAR
	QCONS
	QGETC		;(CAR[LIST1] . CAR[LIST2])
	MOV	(R5)+,R0
	MOV	R0,@2(R5)	;CHAIN TO PREVIOUS RESULT
	MOV	(R5)+,(R0)+
	MOV	R0,@R5	;NEW OPEN CDR
	BR	PAIR1
PAIR4:	TST	4(R5)
	BNE	PAIR7	;JUMP IF LISTS UNEQUAL LENGTH
	TST	(R5)+	;POP OPEN CDR
PAIR5:	MOV	(R5)+,@R5	;MOVE DOWN RESULT
	MOV	(R5)+,@R5
	JMP	@-(R4)
PAIR6:	TST	(R5)+	;POP CAR[LIST2]
PAIR7:	TST	(R5)+	;POP OPEN CDR OF RESULT
	SEC		;SET C BIT
	BR	PAIR5
ZPAIR=.-PAIR
	.END
                                